Perl-Critic-Pulp-100/0002755000175000017500000000000015071066604012172 5ustar ggggPerl-Critic-Pulp-100/MANIFEST0000644000175000017500000002000414016345331013310 0ustar ggggChanges 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 Perl-Critic-Pulp-100/SIGNATURE0000644000175000017500000006731615071066604013471 0ustar ggggThis file contains message digests of all files listed in MANIFEST, signed via the Module::Signature module, version 0.88. 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 81861240de33ec68465258437332442cef42be350238794e5558a5062b6f7fe0 Changes SHA256 02a9f083d88ff0c86874432186a6929765f5c36eb65e379a224f3a25e41a156d MANIFEST SHA256 91eb41c99a794a3fced08c2002ec7a6ed5a8ccb85c20ac26237e6f40dc2f7ba9 MANIFEST.SKIP SHA256 813378d561c3e2421c35409409a79cd9b43fe6d4394e2f7b54854dfe54c9e8c0 META.json SHA256 7ef2c5bfbe12ca7e1a27339dace293e353d5812802621d91c51bc6cabdf277ad META.yml SHA256 14108a6af3d4e6c4ad0832f8a6375ef4b8d9be6697ab84e7cf0204453c6a454d Makefile.PL SHA256 66018de2909c61534cff4919a8ee4a6e6f64fa8e30825751b5324bf122662eb4 README SHA256 a83893a6179acc23bdbf1fdd11cb84bf828ccdd2af6543dc5842bf8a69fd91cc debian/changelog SHA256 2e6d31a5983a91251bfae5aefa1c0a19d8ba3cf601d0e8a706b4cfa9661a6b8a debian/compat SHA256 3c7c6cf552f4e61559b0d07fd0463ee1da01fd444de3ed39ff75cd764b813756 debian/control SHA256 544441648cb104fc7286b72e651eaed11d99fa056a0421931db30d060a7b0fa3 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 943dca77d9158152c6218f717122cf7f631598c0148d8d8cd7efb47cd455d12d devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.pm SHA256 9286c5c008c131742d840e0bc29dcc14ec39e0d8c083b419532a0d3eba8389e1 devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraClose.t SHA256 9b673c4f2bab8482956beaf3dcd2930b14eb95857104c602bd68fbb0963c6faf devel/lib/Perl/Critic/Policy/Documentation/ProhibitMarkupExtraOpen.pm SHA256 d8a21929a41734aa849f60e52c81f49f6ea9d5e1581e9945737c5cddbeb7c252 devel/lib/Perl/Critic/Policy/Modules/UseExporter.pm SHA256 fa91a7e700abcbddf9aa9d068572c9be3545fcd32274f0dd8147d0a3ac06c21e 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 950eca990aafe5b11b0b52b6ea4a6e63880fafa83ac94fc65ef40bc697d2f4a7 devel/version_check.pm SHA256 4f764507b57fdc1beace30d81459f526235973e87320e5cd78abb73dd1de24b4 lib/Perl/Critic/Policy/CodeLayout/ProhibitFatCommaNewline.pm SHA256 6cd627ec17a593e48375af2e4df09ed4ef7a75497ed867309931073b58fede2b lib/Perl/Critic/Policy/CodeLayout/ProhibitIfIfSameLine.pm SHA256 a0c6742adc8d27d3f31a190ef6e2ff17915f4c13ae9fec230586dd8d3fec6e98 lib/Perl/Critic/Policy/CodeLayout/RequireFinalSemicolon.pm SHA256 27c296b81bf29d435163851b54bafc4ca867e9021a91bfd9a51d4fbef73e3728 lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommaAtNewline.pm SHA256 86c7d6835b647f53c045935efa8fc93f462cfbbc3ac7718ecfdd6b8108bcbe56 lib/Perl/Critic/Policy/Compatibility/ConstantLeadingUnderscore.pm SHA256 4bdc72970ebc41206d722d360013b4ba4e06dabb4dae238bdfed787e0f4b7e10 lib/Perl/Critic/Policy/Compatibility/ConstantPragmaHash.pm SHA256 972f5188df11172c7cb1540250aabb6a147c82980727a19a462230f3a2d08fa3 lib/Perl/Critic/Policy/Compatibility/Gtk2Constants.pm SHA256 f842d323cb658dc086deb42bd827e365400b5c413c616c243162f27339186487 lib/Perl/Critic/Policy/Compatibility/PerlMinimumVersionAndWhy.pm SHA256 4e7b57487b5fec1019f2bfee50c94652fca3eb68abf67df5361c767382ca33fc lib/Perl/Critic/Policy/Compatibility/PodMinimumVersion.pm SHA256 771ba526a146b6f19722c82b417b981a53edb47e8486c745fe7e188359b7c980 lib/Perl/Critic/Policy/Compatibility/ProhibitUnixDevNull.pm SHA256 f1f91290e96255301567479da1005dbfcf530565d3ebc93f733776d76ff3f48f lib/Perl/Critic/Policy/Documentation/ProhibitAdjacentLinks.pm SHA256 d9036230bd34d9a86f5aa3e7f906d1c81a536d4c1c2a302d09bb302005391594 lib/Perl/Critic/Policy/Documentation/ProhibitBadAproposMarkup.pm SHA256 82bd76c75f6e459949850e9d1762546857a795ccfad2654856217b336c620d2b lib/Perl/Critic/Policy/Documentation/ProhibitDuplicateHeadings.pm SHA256 d53470e9b2cd23d4c797fc78b66029510e5241993b8de4272f7cd54065d59ecb lib/Perl/Critic/Policy/Documentation/ProhibitDuplicateSeeAlso.pm SHA256 7b74b97f7e5da63aef44f4a043ba1b7b5809dae478198e177ffd8bc097457c6b lib/Perl/Critic/Policy/Documentation/ProhibitLinkToSelf.pm SHA256 b26b1e082c48ee6f9bddbaac3ce5e66050dfb7be01b5dc28b39d8998c013ac77 lib/Perl/Critic/Policy/Documentation/ProhibitParagraphEndComma.pm SHA256 8fa63952d79834a41c0d3f9e0846a812a09ace30e960e5bcf093f8869ff46f1f lib/Perl/Critic/Policy/Documentation/ProhibitParagraphTwoDots.pm SHA256 34a9c697cc77a55573a474de3e7e65716ee5e8019d7c3707fb831b8db295c4c6 lib/Perl/Critic/Policy/Documentation/ProhibitUnbalancedParens.pm SHA256 212e47646a851018c4448a7fc778d446d3a56ff78a55006fc0fe6cac71f0fdd8 lib/Perl/Critic/Policy/Documentation/ProhibitVerbatimMarkup.pm SHA256 86d88eba5367db2a3d20d120d4d42a10001046101fb69cbd77a5a446ebde1c57 lib/Perl/Critic/Policy/Documentation/RequireEndBeforeLastPod.pm SHA256 b6410c0ec43e64cedfb9bd3fad40bc62f085a5cc42af80a08c70231f701b7f63 lib/Perl/Critic/Policy/Documentation/RequireFilenameMarkup.pm SHA256 9fec34ce8704aaa5e95ae58257040dd9e5f31cf6921dde50b29c082c83e8350a lib/Perl/Critic/Policy/Documentation/RequireFinalCut.pm SHA256 5736b6550202bddb5a976c8799ffa629ad1d753a493b8a882abc9b06da8c1494 lib/Perl/Critic/Policy/Documentation/RequireLinkedURLs.pm SHA256 2ef3f75e1ac210fead07ab508b774d121c05597337f62a955e4f46c50672a983 lib/Perl/Critic/Policy/Miscellanea/TextDomainPlaceholders.pm SHA256 2d136af43dbd0ad5b09fdb8a9a95d2c3b57152ca372333b66719c0ad1155f36f lib/Perl/Critic/Policy/Miscellanea/TextDomainUnused.pm SHA256 6a2ecfc57c5e8acc0d0d193646c237265e380b51190b2037ad1be5ce7d75b89e lib/Perl/Critic/Policy/Modules/ProhibitModuleShebang.pm SHA256 96524dc5ba56ad1d357525d124c06a19391163a379e522d6795c2516acac01e7 lib/Perl/Critic/Policy/Modules/ProhibitPOSIXimport.pm SHA256 79d4801554d421f4e6d585804c3f80e2676862a30c6d313cd7145e6d892af5c1 lib/Perl/Critic/Policy/Modules/ProhibitUseQuotedVersion.pm SHA256 4c30314cb6a468bb3e218d7d2fc51ad8d2083b21e7160f34a2bc19c004fa1f1c lib/Perl/Critic/Policy/ValuesAndExpressions/ConstantBeforeLt.pm SHA256 6eb2efb424738a94907909b8afc412d416a92cfad78fe878167d74d881bf0fde lib/Perl/Critic/Policy/ValuesAndExpressions/NotWithCompare.pm SHA256 c068b617dcdd53db813ce0ed9336e5cfe2bb6bc8a154be1bacc8e4da834d98d1 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitArrayAssignAref.pm SHA256 003ac48c003f4dceeb71d1ab09100680a6637b003ee73fe19c96cf6236eb8110 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitBarewordDoubleColon.pm SHA256 b424f5499b9b56e7bf4a226d1c89c8c87c994880dc7814976ddfe09d95b85555 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitDuplicateHashKeys.pm SHA256 3317d970c17188ed47d9c89bfba6b8c1d0b275162356c8057db92629c7e72e68 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyCommas.pm SHA256 950042274cddd0801c7a270d444a9faa54d5a0bbff80e31c46167a6f77a5a14f lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitFiletest_f.pm SHA256 1cbfac78cb372d7876d682b67935a6d8a064bac5328ee7e9b1607d759e5b1686 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNullStatements.pm SHA256 c613e3d2c44eb2e97869e8f5daca05fd925e95b5aa97d0d85eba33c71c3b8835 lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitUnknownBackslash.pm SHA256 c6a260de66ec6587bd9c24b3d0e01cf5482d77b350964be66e6301fbc8bb2ab0 lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumericVersion.pm SHA256 b260e9c023b0802ecafe4ce76db71862b5866e4bf15e8843cec737f15973d9be lib/Perl/Critic/Policy/ValuesAndExpressions/UnexpandedSpecialLiteral.pm SHA256 1e7a6a03f8b63cd7f638f498ab74f5c66891a426d65c63afe2f952c6cfa0d90a lib/Perl/Critic/Pulp.pm SHA256 448b979c1977b5d5bb7e8551c979b10d54dc66ffdd8538a3d25ed56220e98cce lib/Perl/Critic/Pulp/PodParser.pm SHA256 51305d170050cd45e180050a544edbfc7af7a8d4ff5b98bdaa7bc5f2d3c4ca23 lib/Perl/Critic/Pulp/Utils.pm SHA256 c4f93fbbb23f696239fb3070a595e4572797816fbe380f134c88c95cdc5647e7 t/ConstantBeforeLt.t SHA256 a9ee5b028df61c9a414ccf567f78a8173487971d1ce8fefcdf84bf96f320c9fa t/ConstantLeadingUnderscore.t SHA256 debd91abadcfda9f22c8b4ca5854cc23be09b379018dcbe6967729f0fee92463 t/ConstantPragmaHash.t SHA256 46ce275853230e1078850bb2854e6c5d43c7413c68e43198413842d99ac76036 t/Gtk2Constants.t SHA256 91cd2bba3e246abf05c342ed549ed6d902e8a77a43b6c9c4e092e4c918732ac0 t/MyTestHelpers.pm SHA256 2f009ce06e4d93122a1f6d1c1ea41ad59081894eea68549d3eff823352ea1da5 t/NotWithCompare.t SHA256 9dd4fc33361665d214d3ccad3764185a29f13fd5c102d38506c08659b413bf98 t/PerlMinimumVersionAndWhy-pmv.t SHA256 dc20c2a3efc2c9f1f23e23a30455ceaff187b9f03cb6c3afa302b7a3dff5d4de t/PerlMinimumVersionAndWhy.t SHA256 d9c3fc59c6a36467e947452eec2678a7e1afc940f685937aaa0fd2ba4d51f252 t/PodMinimumVersion.t SHA256 af7f54fbf5f9f83c256e40ecf1c52f36d5ca61e8ff35ab26e94f989af70d6239 t/ProhibitAdjacentLinks.t SHA256 4daf0910ab009c5765b1cc9d66163b03dc492706ef4a8412c0c16ac92ba8a726 t/ProhibitArrayAssignAref.t SHA256 591f3137b9ad2ba97f5169583a49f7f4ad982a6cbd62fed134db60104daa8394 t/ProhibitBadAproposMarkup.t SHA256 5d5950540770c4acecee2e4d7b2380873f152da9b3c0416e42b8abfc80870fa0 t/ProhibitBarewordDoubleColon.t SHA256 8a2be34fc904581ecec2fad2ae93d68ae7456c549dfcde48b17a8365ff3a6927 t/ProhibitDuplicateHashKeys.t SHA256 cdf77095a7b46953a3fbc94b317b68fd8fa5042c14848acd606dae838482a4c1 t/ProhibitDuplicateHeadings.t SHA256 0001dfdc82ba8a5c495a873deebc4208973a3d1e285333bc40b9735852c7aa85 t/ProhibitDuplicateSeeAlso.t SHA256 75f4eae944676ce97a38acb4dff76c1b9d2b4c27741f6142796ea8bad88fc4d0 t/ProhibitEmptyCommas.t SHA256 f192e08357ba85da5bba09fbd271f0cddaacaebf7e892151f1adf77e77f61365 t/ProhibitFatCommaNewline.t SHA256 e3afcbac4d5286a14eb71b0c99c26df76211733744d3a5336f7b3166acc3a5cd t/ProhibitFiletest_f.t SHA256 eafd13b93f3fbf36716e149ba3f9bb1c9db7c320e7ec4230e4445c9690ccc48a t/ProhibitIfIfSameLine.t SHA256 98d95cafdc713559c324f0163402a4d89101070469906b43d09a34f4a5c75d3b t/ProhibitLinkToSelf.t SHA256 93c1039568388ea0010abc9cdedb0c100fbbf528edcd40353afa59e4316138cb 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 604c7d0f5cf0147304e9551240333481a577993d514b3755200ab060d959405e t/ProhibitNullStatements.t SHA256 a118098a34bd40ad30e4f43ed8f540923929365139a9052e6185e38822b2c4fd t/ProhibitPOSIXimport.t SHA256 65f60aabcd736bdc64fcab7f1b28379160e61d7e441a39ad765c470e853e94c9 t/ProhibitParagraphEndComma.t SHA256 21614a218391dcb88533dd72025b676217f9b277002b878b430932652316adc2 t/ProhibitParagraphTwoDots.t SHA256 a5851f91a34f298161aa643d9669ceb30e0862315e1e2e1c07fcd1a7a06ef5ff t/ProhibitUnbalancedParens.t SHA256 44c21f64221fbc8220e58a6f81d25ab4a493e855a37a98dcec81ebf4b2618945 t/ProhibitUnixDevNull-load.t SHA256 67249a7b8f9dc7bc88478a58315cec2b9dcc5404aad26a542563828e39de5507 t/ProhibitUnixDevNull.t SHA256 0f9e24164bb79dcbd1d6f4c443adf2537b12f090866058ce60e9a137c90ae690 t/ProhibitUnknownBackslash.t SHA256 5c6b158345db0b11a7e92fd28b622adc57202e758580eec22d1b2f04abab062c t/ProhibitUseQuotedVersion.t SHA256 9683419627bd80f29b0fdbd2fa4f0b97db16b2251f6e850c1396e1075dfb17cd t/ProhibitVerbatimMarkup.t SHA256 322f972ae8b7973a245e493af7f9f0353aa757f7b6895cf161d03a89101c8211 t/Pulp.t SHA256 df2ef6cd4b56cc68d4040adc019573ec2d12f8406f5252da53dcebe1945fc312 t/RequireEndBeforeLastPod.t SHA256 762e54912807ef32701b74c352ccd084801177f3634f3a50306e797058de82b8 t/RequireFilenameMarkup.t SHA256 7d81dd490b76e98f23af355d484ae1bf15eb9cbcca0523fa9aae5d5d2388cb5c t/RequireFinalCut.t SHA256 4afe963d2818b12b8f6c9f3b12a04584ecfebd5a72872fd94ee199225f8dba80 t/RequireFinalSemicolon.t SHA256 2b4a8c79c2bd0d30bafb455006da4a117801cabbcd7bf4005f9ddb9d4fc75ca0 t/RequireLinkedURLs.t SHA256 cf6ef3bd731e0a400519e5b1d381b5d3655441755c886725a3400e23fe90f7e0 t/RequireNumericVersion.t SHA256 7b5167c7c0dd19c6e4fe64b22f3a94546d3fe3937b8d52f3c92ae508427c07be t/RequireTrailingCommaAtNewline.t SHA256 52d0aad645093440694b7ecf3723fabb8a5709f8443b62a40ef6be0c6da1b8ad t/TextDomainPlaceholders.t SHA256 8c401cac4d86f9c9d166fccf04cddd2f48e1a1ae31ebcda846abeaa8cdd6cf11 t/TextDomainUnused.t SHA256 83b383dd0f472e4ef3e853c9a084a934d8ea9899c9e38bffac299f9ccd9f179a t/UnexpandedSpecialLiteral.t SHA256 ffddb9a0f257ea89040fc8c1b69643cb811df5a1f1f3c87a84848f1595657838 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 479a5a0436204528727a74e5257b1c5c6adbebd65b21b6817a196b4e159e7549 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----- iQJOBAEBAwA4FiEE6KmoW7hZbhD/deGn+NC059LSEZEFAmjkbXQaHHVzZXI0Ml9r ZXZpbkB5YWhvby5jb20uYXUACgkQ+NC059LSEZHb6w//USj3gv2vvI0avZ/Cd9+W 2Mg9pPmTe5sy0fa1224wBdoYSfjgOLvvMJTEs3REW3ziyE4G11GzJDDQwBiRzOg+ 3JF4QaQOXXvL0t4Ggx9Ks2bORxmWvMPPOYpYoifEnQ5kOoq6fAg4pfkPkqLVfomg FI4TqdYJIW+gIVxDpLftx9gAjsSqLzlcBUGXq+N3y3dx+kFurDoyrCg68rrrTVIu UC1m+aLR0RnTNMv2e8x1DRSPTcOPZz3Tm9ZcrfVqjH07yFJxdQEx3Ke+4y0uOj9X lYrwRZ9pw+NNW/JvVeHD/DrRgRQZGoRLdSy6hq7lM7s+1xJ+cSRSpFDvQ08lQVIV Yg3zvsjTon6wBM9z6p7iYFINJRGm6/a6kF0wZEztsW1AD/hQynDBlE+0vQJucQYO 6uj6olX0QN1S4j08Z7+daMCf/mwU6Nm2bmVxUAZbl+96fPzLB2EkFiUFe/9+RQmG 5CuyB0T7qjq8NqlUJOJQqNFH5IrpYEC88Vxypr6D5ofElujh3+JYzpeoyvpcd8oP bbJqGFhagr6IYV40IjjtlxviJucHTvXyVcce8kcsluHHe3PAb8l9sBrjqAddDvEu zD9GHBlor2p6j/qpICO2ehBuiJ1yqM7SiQxrKdziMUMQGqTilXQJ/vDgeQhIEIOG jT94f5zPGIyTlgbis73m5WQ= =6tGZ -----END PGP SIGNATURE----- Perl-Critic-Pulp-100/xt/0002755000175000017500000000000015071066561012627 5ustar ggggPerl-Critic-Pulp-100/xt/0-Test-Pod.t0000755000175000017500000000175111655356337014624 0ustar gggg#!/usr/bin/perl -w # 0-Test-Pod.t -- run Test::Pod if available # Copyright 2009, 2010, 2011 Kevin Ryde # 0-Test-Pod.t is shared by several distributions. # # 0-Test-Pod.t 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. # # 0-Test-Pod.t 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 . use 5.004; use strict; use Test::More; # all_pod_files_ok() is new in Test::Pod 1.00 # eval 'use Test::Pod 1.00; 1' or plan skip_all => "due to Test::Pod 1.00 not available -- $@"; Test::Pod::all_pod_files_ok(); exit 0; Perl-Critic-Pulp-100/xt/0-Test-DistManifest.t0000755000175000017500000000231111655356331016457 0ustar gggg#!/usr/bin/perl -w # 0-Test-DistManifest.t -- run Test::DistManifest if available # Copyright 2009, 2010, 2011 Kevin Ryde # 0-Test-DistManifest.t is shared by several distributions. # # 0-Test-DistManifest.t 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. # # 0-Test-DistManifest.t 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 . use 5.004; use strict; use Test::More; # This is only an author test really and it only really does much in a # working directory where newly added files will exist. In a dist dir # something would have to be badly wrong for the manifest to be off. eval { require Test::DistManifest } or plan skip_all => "due to Test::DistManifest not available -- $@"; Test::DistManifest::manifest_ok(); exit 0; Perl-Critic-Pulp-100/xt/0-Test-ConsistentVersion.t0000644000175000017500000000225311655356324017570 0ustar gggg#!/usr/bin/perl -w # 0-Test-ConsistentVersion.t -- run Test::ConsistentVersion if available # Copyright 2011 Kevin Ryde # 0-Test-ConsistentVersion.t is shared by several distributions. # # 0-Test-ConsistentVersion.t 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. # # 0-Test-ConsistentVersion.t 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 . use 5.004; use strict; use Test::More; eval { require Test::ConsistentVersion } or plan skip_all => "due to Test::ConsistentVersion not available -- $@"; Test::ConsistentVersion::check_consistent_versions (no_readme => 1, # no version number in my READMEs no_pod => 1, # no version number in my docs, at the moment ); # ! -e 'README'); exit 0; Perl-Critic-Pulp-100/xt/0-no-debug-left-on.t0000755000175000017500000000712313561713016016213 0ustar gggg#!/usr/bin/perl -w # 0-no-debug-left-on.t -- check no Smart::Comments left on # Copyright 2011, 2012, 2017, 2019 Kevin Ryde # 0-no-debug-left-on.t is shared by several distributions. # # 0-no-debug-left-on.t 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. # # 0-no-debug-left-on.t 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 Test::NoSmartComments which uses Module::ScanDeps. require 5; use strict; Test::NoDebugLeftOn->Test_More(verbose => 0); exit 0; package Test::NoDebugLeftOn; use strict; use ExtUtils::Manifest; sub Test_More { my ($class, %options) = @_; require Test::More; Test::More::plan (tests => 1); Test::More::ok ($class->check (diag => \&Test::More::diag, %options)); 1; } sub check { my ($class, %options) = @_; my $diag = $options{'diag'}; if (! -e 'Makefile.PL') { &$diag ('skip, no Makefile.PL so not ExtUtils::MakeMaker'); return 1; } my $href = ExtUtils::Manifest::maniread(); my @files = keys %$href; my $good = 1; my @perl_files = grep {m{ ^lib/ |^(lib|examples|x?t)/.*\.(p[lm]|t)$ |^Makefile.PL$ |^[^/]+$ }x } @files; my $filename; foreach $filename (@perl_files) { if ($options{'verbose'}) { &$diag ("perl file ",$filename); } if (! open FH, "< $filename") { &$diag ("Oops, cannot open $filename: $!"); $good = 0; next; } while () { if (/^__END__/) { last; } # only a DEBUG=> non-zero number is bad, so an expression can copy a # debug from another package if (/(DEBUG\s*=>\s*[1-9][0-9]*)/ || /^[ \t]*((use|no) (Smart|Devel)::Comments)/ ) { print STDERR "\n$filename:$.: leftover: $_\n"; $good = 0; } # no "use lib ... devel", except in xt/*.t unless ($filename =~ /\bxt\b/) { if (/^[ \t]*(use lib\b.*devel.*)/) { print STDERR "\n$filename:$.: leftover: $_\n"; $good = 0; } } } if (! close FH) { &$diag ("Oops, error closing $filename: $!"); $good = 0; next; } } my @C_files = grep {m{ # toplevel or lib .c and .xs files ^[^/]*\.([ch]|xs)$ |^(lib|examples|x?t)/.*\.([ch]|xs)$ }x } @files; foreach $filename (@C_files) { if ($options{'verbose'}) { &$diag ("C/XS file ",$filename); } if (! open FH, "< $filename") { &$diag ("Oops, cannot open $filename: $!"); $good = 0; next; } while () { # #define DEBUG 1 # #define MY_DEBUG 1 if (/^#\s*define\s+(MY_)DEBUG\s+[1-9]/ ) { print STDERR "\n$filename:$.: leftover: $_\n"; $good = 0; } } if (! close FH) { &$diag ("Oops, error closing $filename: $!"); $good = 0; next; } } &$diag ("checked ",scalar(@perl_files)," perl files, ", scalar(@C_files)," C/XS files\n"); return $good; } Perl-Critic-Pulp-100/xt/0-file-is-part-of.t0000644000175000017500000000622212536755447016062 0ustar gggg#!/usr/bin/perl -w # Copyright 2011, 2012, 2013, 2015 Kevin Ryde # 0-file-is-part-of.t is shared by several distributions. # # 0-file-is-part-of.t 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. # # 0-file-is-part-of.t 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 . require 5; use strict; use Test::More tests => 1; use lib 't'; use MyTestHelpers; BEGIN { MyTestHelpers::nowarnings(); } ok (Test::FileIsPartOfDist->check(verbose=>1), 'Test::FileIsPartOfDist'); exit 0; package Test::FileIsPartOfDist; BEGIN { require 5 } use strict; use ExtUtils::Manifest; use File::Slurp; # uncomment this to run the ### lines # use Smart::Comments; sub import { my $class = shift; my $arg; foreach $arg (@_) { if ($arg eq '-test') { require Test; Test::plan(tests=>1); is ($class->check, 1, 'Test::FileIsPartOfDist'); } } return 1; } sub new { my $class = shift; return bless { @_ }, $class; } sub check { my $class = shift; my $self = $class->new(@_); my $manifest = ExtUtils::Manifest::maniread(); if (! $manifest) { $self->diag("no MANIFEST perhaps"); return 0; } my @filenames = keys %$manifest; my $distname = $self->makefile_distname; if (! defined $distname) { $self->diag("Oops, DISTNAME not found in Makefile"); return 0; } if ($self->{'verbose'}) { $self->diag("DISTNAME $distname"); } my $good = 1; my $filename; foreach $filename (@filenames) { if (! $self->check_file_is_part_of($filename,$distname)) { $good = 0; } } return $good; } sub makefile_distname { my ($self) = @_; my $filename = "Makefile"; my $content = File::Slurp::read_file ($filename); if (! defined $content) { $self->diag("Cannot read $filename: $!"); return undef; } my $distname; if ($content =~ /^DISTNAME\s*=\s*([^#\n]*)/m) { $distname = $1; $distname =~ s/\s+$//; ### $distname if ($distname eq 'App-Chart') { $distname = 'Chart'; } # hack } return $distname; } sub check_file_is_part_of { my ($self, $filename, $distname) = @_; my $content = File::Slurp::read_file ($filename); if (! defined $content) { $self->diag("Cannot read $filename: $!"); return 0; } $content =~ /([T]his file is part of[^\n]*)/i or return 1; my $got = $1; if ($got =~ /[T]his file is part of \Q$distname\E\b/i) { return 1; } $self->diag("$filename: $got"); $self->diag("expected DISTNAME: $distname"); return 0; } sub diag { my $self = shift; my $func = $self->{'diag_func'} || eval { Test::More->can('diag') } || \&_diag; &$func(@_); } sub _diag { my $msg = join('', map {defined($_)?$_:'[undef]'} @_)."\n"; $msg =~ s/^/# /mg; print STDERR $msg; } Perl-Critic-Pulp-100/xt/0-Test-YAML-Meta.t0000755000175000017500000000346113046214104015505 0ustar gggg#!/usr/bin/perl -w # 0-Test-YAML-Meta.t -- run Test::CPAN::Meta::YAML if available # Copyright 2009, 2010, 2011, 2013, 2014, 2017 Kevin Ryde # 0-Test-YAML-Meta.t is shared by several distributions. # # 0-Test-YAML-Meta.t 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. # # 0-Test-YAML-Meta.t 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 . use 5.004; use strict; use Test::More; my $meta_filename = 'META.yml'; unless (-e $meta_filename) { plan skip_all => "$meta_filename doesn't exist -- assume this is a working directory not a dist"; } plan tests => 3; SKIP: { eval { require CPAN::Meta::Validator; 1 } or skip "due to CPAN::Meta::Validator not available -- $@"; eval { require YAML; 1 } or skip "due to YAML module not available -- $@", 1; diag "CPAN::Meta::Validator version ", CPAN::Meta::Validator->VERSION; my $struct = YAML::LoadFile ($meta_filename); my $cmv = CPAN::Meta::Validator->new($struct); ok ($cmv->is_valid); if (! $cmv->is_valid) { diag "CPAN::Meta::Validator errors:"; foreach ($cmv->errors) { diag $_; } } } { # Test::CPAN::Meta::YAML version 0.15 for upper case "optional_features" names # eval 'use Test::CPAN::Meta::YAML 0.15; 1' or plan skip_all => "due to Test::CPAN::Meta::YAML 0.15 not available -- $@"; Test::CPAN::Meta::YAML::meta_spec_ok('META.yml'); } exit 0; Perl-Critic-Pulp-100/xt/0-Test-Synopsis.t0000755000175000017500000000176411655356314015730 0ustar gggg#!/usr/bin/perl -w # 0-Test-Synopsis.t -- run Test::Synopsis if available # Copyright 2009, 2010, 2011 Kevin Ryde # 0-Test-Synopsis.t is shared by several distributions. # # 0-Test-Synopsis.t 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. # # 0-Test-Synopsis.t 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 . use 5.004; use strict; use Test::More; eval 'use Test::Synopsis; 1' or plan skip_all => "due to Test::Synopsis not available -- $@"; ## no critic (ProhibitCallsToUndeclaredSubs) all_synopsis_ok(); exit 0; Perl-Critic-Pulp-100/xt/policy-lists.t0000644000175000017500000000470012111612241015426 0ustar gggg#!/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 . # Check that the supported fields described in each pod matches what the # code says. use 5.005; use strict; use FindBin; use ExtUtils::Manifest; use List::Util 'max'; use File::Spec; use Test::More; use lib 't','xt'; use MyTestHelpers; BEGIN { MyTestHelpers::nowarnings() } # uncomment this to run the ### lines # use Smart::Comments; plan tests => 1; my $toplevel_dir = File::Spec->catdir ($FindBin::Bin, File::Spec->updir); my $manifest_file = File::Spec->catfile ($toplevel_dir, 'MANIFEST'); my $manifest = ExtUtils::Manifest::maniread ($manifest_file); my @lib_policies = map {m{^lib/Perl/Critic/Policy/(.+)\.pm$} ? $1 : ()} keys %$manifest; foreach (@lib_policies) { s{/}{::} } @lib_policies = sort @lib_policies; ### @lib_policies diag "module policies count ",scalar(@lib_policies); #------------------------------------------------------------------------------ { open FH, 'lib/Perl/Critic/Pulp.pm' or die $!; my $content = do { local $/; }; # slurp close FH or die; # ### $content { $content =~ /=for my_pod policy_list begin(.*)=for my_pod policy_list end/s or die "pulp_list not matched, content:\n",$content; my $pulp_list = $1; my @pulp_list; while ($pulp_list =~ /^=item L<([^|]+)/mg) { push @pulp_list, $1; } @pulp_list = sort @pulp_list; ### @pulp_list diag "pulp list count ",scalar(@pulp_list); my $s = join(', ',@pulp_list); my $l = join(', ',@lib_policies); is ($s, $l, 'Pulp.pm policy list'); my $j = "$s\n$l"; $j =~ /^(.*)(.*)\n\1(.*)/ or die; my $sd = $2; my $ld = $3; if ($sd) { diag "pulp list: ",$sd; diag "modules: ",$ld; } } } #------------------------------------------------------------------------------ exit 0; Perl-Critic-Pulp-100/xt/0-META-read.t0000755000175000017500000001071512136177162014614 0ustar gggg#!/usr/bin/perl -w # 0-META-read.t -- check META.yml can be read by various YAML modules # Copyright 2009, 2010, 2011, 2012, 2013 Kevin Ryde # 0-META-read.t is shared among several distributions. # # 0-META-read.t 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. # # 0-META-read.t 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 . use 5.005; use strict; use Test::More; use lib 't'; use MyTestHelpers; BEGIN { MyTestHelpers::nowarnings(); } # When some of META.yml is generated by explicit text in Makefile.PL it can # be easy to make a mistake in the syntax, or indentation, etc, so the idea # here is to check it's readable from some of the YAML readers. # # The various readers differ in how strictly they look at the syntax. # There's no attempt here to say one of them is best or tightest or # whatever, just see that they all work. # # See 0-Test-YAML-Meta.t for Test::YAML::Meta which looks into field # contents, as well as maybe the YAML formatting. my $meta_filename; # allow for ancient perl, maybe eval { require FindBin; 1 } # new in 5.004 or plan skip_all => "FindBin not available -- $@"; eval { require File::Spec; 1 } # new in 5.005 or plan skip_all => "File::Spec not available -- $@"; diag "FindBin $FindBin::Bin"; $meta_filename = File::Spec->catfile ($FindBin::Bin, File::Spec->updir, 'META.yml'); -e $meta_filename or plan skip_all => "$meta_filename doesn't exist -- assume this is a working directory not a dist"; plan tests => 5; SKIP: { eval { require YAML; 1 } or skip "due to YAML module not available -- $@", 1; my $ok = eval { YAML::LoadFile ($meta_filename); 1 } or diag "YAML::LoadFile() error -- $@"; ok ($ok, "Read $meta_filename with YAML module"); } # YAML 0.68 is in fact YAML::Old, or something weird -- don't think they can # load together # # SKIP: { # eval { require YAML::Old; 1 } # or skip 'due to YAML::Old not available -- $@', 1; # # eval { YAML::Old::LoadFile ($meta_filename) }; # is ($@, '', # "Read $meta_filename with YAML::Old"); # } SKIP: { eval { require YAML::Syck; 1 } or skip "due to YAML::Syck not available -- $@", 1; my $ok = eval { YAML::Syck::LoadFile ($meta_filename); 1 } or diag "YAML::Syck::LoadFile() error -- $@"; ok ($ok, "Read $meta_filename with YAML::Syck"); } SKIP: { eval { require YAML::Tiny; 1 } or skip "due to YAML::Tiny not available -- $@", 1; my $ok = eval { YAML::Tiny->read ($meta_filename); 1 } or diag "YAML::Tiny->read() error -- $@"; ok ($ok, "Read $meta_filename with YAML::Tiny"); } SKIP: { eval { require YAML::XS; 1 } or skip "due to YAML::XS not available -- $@", 1; my $ok = eval { YAML::XS::LoadFile ($meta_filename); 1 } or diag "YAML::XS::LoadFile() error -- $@"; ok ($ok, "Read $meta_filename with YAML::XS"); } # Parse::CPAN::Meta describes itself for use on "typical" META.yml, so not # sure if demanding it works will more exercise its subset of yaml than the # correctness of our META.yml. At any rate might like to know if it fails, # so as to avoid tricky yaml for everyone's benefit, maybe. # SKIP: { eval { require Parse::CPAN::Meta; 1 } or skip "due to Parse::CPAN::Meta not available -- $@", 1; my $ok = eval { Parse::CPAN::Meta::LoadFile ($meta_filename); 1 } or diag "Parse::CPAN::Meta::LoadFile() error -- $@"; ok ($ok, "Read $meta_filename with Parse::CPAN::Meta::LoadFile"); } # Data::YAML::Reader 0.06 doesn't like header "--- #YAML:1.0" with the # # part produced by other YAML writers, so skip for now # # SKIP: { # eval { require Data::YAML::Reader; 1 } # or skip 'due to Data::YAML::Reader not available -- $@', 1; # # my $reader = Data::YAML::Reader->new; # open my $fh, '<', $meta_filename # or die "Cannot open $meta_filename"; # my $str = do { local $/=undef; <$fh> }; # close $fh or die; # # # if ($str !~ /\.\.\.$/) { # # $str .= "..."; # # } # my @lines = split /\n/, $str; # push @lines, "..."; # use Data::Dumper; # print Dumper(\@lines); # # # { local $,="\n"; print @lines,"\n"; } exit 0; Perl-Critic-Pulp-100/lib/0002755000175000017500000000000015071066561012742 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/0002755000175000017500000000000015071066561013644 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/0002755000175000017500000000000015071066561015061 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/Pulp.pm0000644000175000017500000002531114017115130016321 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 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 . package Perl::Critic::Pulp; use 5.006; use strict; use warnings; our $VERSION = 100; 1; __END__ =for stopwords perlcritic builtin multi-constants Gtk2 Gtk2Constants perlcritic's Ryde barewords un-typical parens de gustibus disputandum backslashing initializers globals add-ons =head1 NAME Perl::Critic::Pulp - some add-on perlcritic policies =head1 DESCRIPTION This is a collection of add-on policies for C. They're under a "pulp" theme plus other themes according to their purpose (see L). =for my_pod policy_list begin =head2 Bugs =over =item L Avoid newline before C<=E> not quoting. =item L Avoid C<} if () {> perhaps meant to be C. =item L Check keyword arguments to C<__x()>, C<__nx()>, etc. =item L Don't quote a version requirement like C =item L C<$VERSION> plain number for comparisons and checking. =item L Avoid problems with C<< FOO < 123 >> =item L Avoid problems with C =item L Dubious C<@array=[1,2,3]> array/arrayref assignments. =item L Duplicate literal keys C<%h = (xyz=E123, xyz=E456)>. =item L Don't use C<-f>. =item L C<__PACKAGE__> etc special words not expanding. =back =head2 Compatibility =over =item L Version requirement for hash style multi-constants. =item L Version requirement for constants with leading underscore. =item L Gtk2 module version requirement for some constants. =item L Perl version declared against features used. =item L Perl version declared against POD features used. =item L Prefer C<< File::Spec->devnull >> over F. =back =head2 Efficiency =over =item L Put C<__END__> before POD at end of file. =item L C imported but not used. =item L Don't import the whole of C. =back =head2 Cosmetic =over =item L Comma "," at the end of list, if at a newline. =item L Semicolon C<;> on the last statement of a subroutine or block. =item L Stray consecutive commas C<,,> =item L Stray semicolons C<;> =item L Unknown C<\z> etc escapes in strings. =item L Double-colon barewords C =item L No C<#!> interpreter line in F<.pm> files. =back =head2 Documentation =over =item L Unbalanced or mismatched ( ) parens, brackets and braces. =item L Put commas or some text between adjacent C<< LEE >> links. =item L Don't duplicate C<=head> headings. =item L Don't duplicate C<< LEE >> links in SEE ALSO sections. =item L Avoid C<< CEE >> in NAME section, bad for man's "apropos" output. =item L Markup /foo filenames. =item L Don't C<< LEE >> link to the document itself. =item L Don't end paragraph with "," comma. =item L Don't end paragraph with ".." (stray extra dot). =item L Verbatim paragraphs not expanding C<< CEE >> etc markup. =item L Have a C<=cut> at end of file. =item L Use C<< LEE >> markup on URLs. =back =for my_pod policy_list end =head2 Selecting You can always enable or disable the policies you do or don't want (see L). You may have already realized that there's a wide range of builtin and add-on perlcritic policies ranging from buggy practice to deliberately restrictive or even quite bizarre. You're not meant to pass everything. Some policies may even be mutually contradictory. The restrictive policies are meant as building blocks for a house style. For example C here, or something like C. They're usually a matter of personal preference, and "non de gustibus disputandum" as they say in the classics. Trying to follow all such policies would give away big parts of the language and quite likely result in very un-typical code. Some of the restrictive policies are geared towards beginners. C here or C are along those lines. There might for instance be good backslashing which the prohibition doesn't recognise, or local variable initializers make no sense for output variables like C<$!>, once you get to the level of knowing to use C to preserve such globals. In general the POD of each policy is supposed to explain the motivation so you can see whether you want it or not. If you're not turning off or drastically customizing at least half of all policies then you're either not trying or you're much too easily lead! =head1 OTHER NOTES In most of the perlcritic documentation, including the Pulp add-ons here, policy names appear without the full C class part. In Emacs try C to make C automatically expand a suffix part at point, or C for the same to go to the source. =over =item L =item L =back In perlcritic's output you can ask for C<%P> to see the full policy package name to run C or copy or follow etc. Here's a good output format you can put in your F<.perlcriticrc>. The file:line:column: part is a style Emacs will recognise. verbose=%f:%l:%c:\n %P\n %m\n See L for all available C<%> escapes. C which comes with perlcritic has regexp patterns for Emacs to recognise the builtin perlcritic formats, but it's easier to output "file:line:column:" in the first place. =head1 SEE ALSO L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Pulp/0002755000175000017500000000000015071066561016001 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/Pulp/Utils.pm0000644000175000017500000002365514017115130017432 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Pulp::Utils; use 5.006; use strict; use warnings; use version (); # but don't import qv() our $VERSION = 100; use base 'Exporter'; our @EXPORT_OK = qw(parameter_parse_version version_if_valid include_module_version elem_package elem_in_BEGIN elem_is_comma_operator %COMMA); our %COMMA = (',' => 1, '=>' => 1); sub parameter_parse_version { my ($self, $parameter, $str) = @_; my $version; if (defined $str && $str ne '') { $version = version_if_valid ($str); if (! defined $version) { $self->throw_parameter_value_exception ($parameter->get_name, $str, undef, # source 'invalid version number string'); } } $self->__set_parameter_value ($parameter, $version); } # return a version.pm object, or undef if $str is invalid sub version_if_valid { my ($str) = @_; # this is a nasty hack to notice "not a number" warnings, and for version # 0.81 possibly throwing errors too my $good = 1; my $version; { local $SIG{'__WARN__'} = sub { $good = 0 }; eval { $version = version->new($str) }; } return ($good ? $version : undef); } # This regexp is what Perl's toke.c S_force_version() demands, as of # versions 5.004 through 5.8.9. A version number in a "use" must start with # a digit and then have only digits, dots and underscores. In particular # other normal numeric forms like hex or exponential are not taken to be # version numbers, and even omitting the 0 from a decimal like ".25" is not # a version number. # our $use_module_version_number_re = qr/^v?[0-9][0-9._]*$/; sub include_module_version { my ($inc) = @_; # only a module style "use Foo", not a perl version num like "use 5.010" defined ($inc->module) || return undef; my $ver = $inc->schild(2) || return undef; # ENHANCE-ME: when PPI recognises v-strings may have to extend this $ver->isa('PPI::Token::Number') || return undef; $ver->content =~ $use_module_version_number_re or return undef; # must be followed by whitespace, or comment, or end of statement, so # # use Foo 10 -3; <- version 10, arg -3 # use Foo 10-3; <- arg 7 # # use Foo 10# <- version 10, arg -3 # -3; # if (my $after = $ver->next_sibling) { unless ($after->isa('PPI::Token::Whitespace') || $after->isa('PPI::Token::Comment') || ($after->isa('PPI::Token::Structure') && $after eq ';')) { return undef; } } return $ver; } # $inc is a PPI::Statement::Include. # Return the element which is the start of the first argument to its # import() or unimport(), for "use" or "no" respectively. # # A "require" is treated the same as "use" and "no", but arguments to it # like "require Foo::Bar '-init';" is in fact a syntax error. # sub include_module_first_arg { my ($inc) = @_; defined ($inc->module) || return; my $arg; if (my $ver = include_module_version ($inc)) { $arg = $ver->snext_sibling; } else { # eg. "use Foo 'xxx'" $arg = $inc->schild(2); } # don't return terminating ";" if ($arg && $arg->isa('PPI::Token::Structure') && $arg->content eq ';' && ! $arg->snext_sibling) { return; } return $arg; } # Hack to set Perl::Critic::Violation location to $linenum in $doc_str. # Have thought about validating _location and _source fields before mangling # them, but hopefully there'll be a documented interface to use before long. # sub _violation_override_linenum { my ($violation, $doc_str, $linenum) = @_; # if ($violation->can('set_line_number_offset')) { # $violation->set_line_number_offset ($linenum - 1); # } else { bless $violation, 'Perl::Critic::Pulp::PodMinimumVersionViolation'; $violation->{_Pulp_linenum_offset} = $linenum - 1; $violation->{'_source'} = _str_line_n ($doc_str, $linenum); return $violation; } # starting contents of line number $n within $str # $n==0 is the first line sub _str_line_n { my ($str, $n) = @_; $n--; return ($str =~ /^(.*\n){$n}(.*)/ ? $2 : ''); } sub elem_package { my ($elem) = @_; for (;;) { $elem = $elem->sprevious_sibling || $elem->parent || return undef; if ($elem->isa ('PPI::Statement::Package')) { return $elem; } } } sub elem_in_BEGIN { my ($elem) = @_; while ($elem = $elem->parent) { if ($elem->isa('PPI::Statement::Scheduled')) { return ($elem->type eq 'BEGIN'); } } return 0; } sub elem_is_comma_operator { my ($elem) = @_; return ($elem->isa('PPI::Token::Operator') && $Perl::Critic::Pulp::Utils::COMMA{$elem}); } 1; __END__ =for stopwords perlcritic Ryde ie =head1 NAME Perl::Critic::Pulp::Utils - shared helper code for the Pulp perlcritic add-on =head1 SYNOPSIS use Perl::Critic::Pulp::Utils; =head1 DESCRIPTION This is a bit of a grab bag, but works as far as it goes. =head1 FUNCTIONS =head2 Element Functions =over =item C<$pkgelem = Perl::Critic::Pulp::Utils::elem_package ($elem)> C<$elem> is a C. Return the C containing C<$elem>, or C if C<$elem> is not in the scope of any package statement. The search upwards begins with the element preceding C<$elem>, so if C<$elem> itself is a C then that's not the one returned, instead its containing package. =item C<$bool = Perl::Critic::Pulp::Utils::elem_in_BEGIN ($elem)> Return true if C<$elem> (a C) is within a C block (ie. a C of type "BEGIN"). =item C<$bool = Perl::Critic::Pulp::Utils::elem_is_comma_operator ($elem)> Return true if C<$elem> (a C) is a comma operator (C), either "," or "=>'. =cut # Not sure about this just yet. This first_arg would be a matching pair. # # =item C<$numelem = Perl::Critic::Pulp::Utils::include_module_version ($incelem)> # # C<$incelem> is a C. If it's a module type C # or C with a version number for Perl to check then return that version # number element, otherwise return C. # # use Foo 1.23 qw(arg1 arg2); # no Bar 0.1; # # A module version is a literal number following the module name, with either # nothing after it for that statement, or with no comma before the statement # arguments. # # C and other module C handlers may interpret a number # argument as a version to be checked, but C looks # only for version numbers which Perl itself will check. # # A module C type C<$incelem> is treated the same as C and # C, but a module version number like "require Foo::Bar 1.5" is a Perl # syntax error. A Perl version C<$incelem> like C is not a module # include and the return is C for it. # # As of PPI 1.203 there's no v-number parsing, so the returned element is only # ever a C. Perhaps that will change. # # C has a similar C<$incelem-Emodule_version> # method, but it's wrong as of PPI 1.209. It takes all numbers as version # numbers, whereas Perl doesn't accept exponential format floats, only the # restricted number forms of Perl's F C. =back =head2 Policy Parameter Functions =over =item C This is designed for use as the C field of a policy's C entry for a parameter which is a version number. { name => 'above_version', description => 'Check only above this version of Perl.', behavior => 'string', parser => \&Perl::Critic::Pulp::Utils::parameter_parse_version, } C<$str> is parsed with the C module. If valid then the parameter is set with C<$self-E__set_parameter_value> to the resulting C object (so for example field $self->{'_above_version'}). If invalid then an exception is thrown per C<$self-Ethrow_parameter_value_exception>. =back =head1 EXPORTS Nothing is exported by default, but the functions can be requested in usual C style, use Perl::Critic::Pulp::Utils 'elem_in_BEGIN'; if (elem_in_BEGIN($elem)) { # ... } There's no C<:all> tag since this module is meant as a grab-bag of functions and importing as-yet unknown things would be asking for name clashes. =head1 SEE ALSO L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Pulp/PodParser.pm0000644000175000017500000001613614017115130020225 0ustar gggg# Copyright 2010, 2011, 2012, 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 . package Perl::Critic::Pulp::PodParser; use 5.006; use strict; use warnings; use Perl::Critic::Pulp::Utils; use base 'Pod::Parser'; our $VERSION = 100; # uncomment this to run the ### lines # use Smart::Comments; # sub new { # my $class = shift; # ### Pulp-PodParser new() # my $self = $class->SUPER::new (@_); # return $self; # } sub initialize { my ($self) = @_; ### initialize() ... # empty violations for violations() to return before a parse $self->{'violations'} = []; $self->{'in_begin'} = ''; $self->errorsub ('error_handler'); # method name # Note: The violations list is never cleared. Might like to do so at the # start of a new a pod document, though this parser is only ever used on a # single document and then discarded. begin_input() and begin_pod() are # no good as they're invoked for each chunk fed in by parse_from_elem(). } sub error_handler { my ($self, $errmsg) = @_; ### error_handler() ... return 1; # error handled # Don't think it's the place of this policy to report pod parse errors. # Maybe within sections a policy is operating on, on the basis that could # affect the goodness of its checks, but better leave it all to podchecker # or other perlcritic policies. # # my $policy = $self->{'policy'}; # my $elem = $self->{'elem'}; # push @{$self->{'violations'}}, # $policy->violation ("Pod::Parser $errmsg", '', $elem); } sub parse_from_elem { my ($self, $elem) = @_; ### Pulp-PodParser parse_from_elem(): ref($elem) my $elems = ($elem->can('find') ? $elem->find ('PPI::Token::Pod') : [ $elem ]) || return; # find() returns false if nothing found foreach my $pod (@$elems) { ### pod chunk at linenum: $pod->line_number $self->{'elem'} = $pod; $self->parse_from_string ($pod->content); } } # this is generic except for holding onto $str ready for violation override sub parse_from_string { my ($self, $str) = @_; $self->{'str'} = $str; require IO::String; my $fh = IO::String->new ($str); $self->parse_from_filehandle ($fh); } sub command { my ($self, $command, $text, $linenum) = @_; if ($command eq 'begin') { push @{$self->{'in_begin_stack'}}, $self->{'in_begin'}; if ($text =~ /^:/) { # "=begin :foo" is ordinary POD $self->{'in_begin'} = ''; } elsif ($text =~ /(\w+)/) { $self->{'in_begin'} = $1; # first word only } else { # "=begin" with no word chars ... $self->{'in_begin'} = ''; } ### in_begin: $self->{'in_begin'} } elsif ($command eq 'end') { $self->{'in_begin'} = pop @{$self->{'in_begin_stack'}}; if (! defined $self->{'in_begin'}) { $self->{'in_begin'} = ''; } ### pop to in_begin: $self->{'in_begin'} } } use constant verbatim => ''; use constant textblock => ''; sub violation_at_linenum { my ($self, $message, $linenum) = @_; ### violation on elem: ref($self->{'elem'}) my $policy = $self->{'policy'}; ### policy: ref($policy) my $violation = $policy->violation ($message, '', $self->{'elem'}); # fix dodgy Perl::Critic::Policy 1.108 violation() ending up with caller # package not given $policy if ($violation->policy eq __PACKAGE__ && defined $violation->{'_policy'} && $violation->{'_policy'} eq __PACKAGE__) { $violation->{'_policy'} = ref($policy); } Perl::Critic::Pulp::Utils::_violation_override_linenum ($violation, $self->{'str'}, $linenum); ### $violation push @{$self->{'violations'}}, $violation; } sub violation_at_linenum_and_textpos { my ($self, $message, $linenum, $text, $pos) = @_; ### violation_at_linenum_and_textpos() ### $message ### $linenum ### $pos my $part = substr($text,0,$pos); $linenum += ($part =~ tr/\n//); $self->violation_at_linenum ($message, $linenum); } # return list of violation objects (possibly empty) sub violations { my ($self) = @_; return @{$self->{'violations'}}; } #------------------------------------------------------------------------------ # This not documented yet. Might prefer to split it out for separate use too. # # Not sure about padding to make the column right. Usually good, but # perhaps not always. Maybe should offset a column by examining # $paraobj->cmd_prefix() and $paraobj->cmd_name(). { my %command_non_text = (for => 1, begin => 1, end => 1, cut => 1); # The parameters are as per the command() method of Pod::Parser. # If $command contains text style markup then call $self->textblock() on # its text. # All commands except =for, =begin, =end and =cut have marked-up text. # Eg. =head2 C # sub command_as_textblock { my ($self, $command, $text, $linenum, $paraobj) = @_; ### command: $command ### $text # $text can be undef if =foo with no newline at end-of-file if (defined $text && ! $command_non_text{$command}) { # padded to make the column number right, the leading spaces do no harm # for this policy $self->textblock ((' ' x (length($command)+1)) . $text, $linenum, $paraobj); } return ''; } } 1; __END__ =for stopwords perlcritic Ryde =head1 NAME Perl::Critic::Pulp::PodParser - shared POD parsing code for the Pulp perlcritic add-on =head1 SYNOPSIS use base 'Perl::Critic::Pulp::PodParser'; =head1 DESCRIPTION This is only meant for internal use yet. It's some shared parse-from-element, error suppression, no output, violation accumulation and violation line number things for POD parsing in policies. =head1 SEE ALSO L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/0002755000175000017500000000000015071066561016320 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/Policy/Compatibility/0002755000175000017500000000000015071066561021131 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/Policy/Compatibility/ConstantLeadingUnderscore.pm0000644000175000017500000002444014017115127026570 0ustar gggg# Copyright 2011, 2012, 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 . package Perl::Critic::Policy::Compatibility::ConstantLeadingUnderscore; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp::Utils; use Perl::Critic::Policy::Miscellanea::TextDomainPlaceholders; use version (); # but don't import qv() # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM; use constant default_themes => qw(pulp compatibility); use constant applies_to => 'PPI::Document'; my $perl_ok_version = version->new('5.006'); my $constant_ok_version = version->new('1.02'); sub violates { my ($self, $elem, $document) = @_; my @violations; my $perlver; # a "version" object my $modver; # a "version" object my $aref = $document->find ('PPI::Statement::Include') || return; # if no includes at all foreach my $inc (@$aref) { $inc->type eq 'use' || ($inc->type eq 'require' && Perl::Critic::Pulp::Utils::elem_in_BEGIN($inc)) || next; if (my $ver = $inc->version) { # "use 5.006" etc perl version $ver = version->new ($ver); if (! defined $perlver || $ver > $perlver) { $perlver = $ver; # maximum seen so-far if ($perlver >= $perl_ok_version) { # adequate perl version demanded, stop here last; } } next; } ($inc->module||'') eq 'constant' || next; if (my $ver = Perl::Critic::Pulp::Utils::include_module_version ($inc)) { ### $ver # PPI::Token::Number::Float $ver = version->new ($ver->content); if (! defined $modver || $ver > $modver) { $modver = $ver; if ($modver >= $constant_ok_version) { # adequate "constant" version demanded, stop here last; } } } my $name = _use_constant_single_name ($inc); if (defined $name && $name =~ /^_/) { push @violations, $self->violation ("'use constant' with leading underscore requires perl 5.6 or constant 1.02 (at this point have " . (defined $perlver ? "perl $perlver" : "no perl version") . (defined $modver ? ", constant $modver)" : ", no constant version)"), '', $inc); } } return @violations; } # $inc is a PPI::Statement::Include with type "use" and module "constant". # If it's a single-name "use constant foo => ..." then return the name # string "foo". If it's a multi-constant or something unrecognised then # return undef.. # sub _use_constant_single_name { my ($inc) = @_; my $arg = Perl::Critic::Pulp::Utils::include_module_first_arg ($inc) || return undef; # empty "use constant" or version "use constant 1.05" if ($arg->isa('PPI::Token::Word')) { # use constant FOO ... return $arg->content; } if ($arg->isa('PPI::Token::Quote::Single') || $arg->isa('PPI::Token::Quote::Literal')) { # use constant 'FOO', ... # use constant q{FOO}, ... return $arg->literal; } if ($arg->isa('PPI::Token::Quote::Double') || $arg->isa('PPI::Token::Quote::Interpolate')) { # ENHANCE-ME: use $arg->interpolations() when available also on # PPI::Token::Quote::Interpolate my $str = $arg->string; if (! Perl::Critic::Policy::Miscellanea::TextDomainPlaceholders::_string_any_vars($str)) { # use constant "FOO", ... # use constant qq{FOO}, ... # not quite right, but often close enough return $str; } } # a hash or an expression or something unrecognised return undef; } # $str is the contents of a "" or qq{} string # return true if it has any $ or @ interpolation forms sub _string_any_vars { my ($str) = @_; return ($str =~ /(^|[^\\])(\\\\)*[\$@]/); } 1; __END__ =for stopwords multi-constant multi-constants CPAN perl ok ConstantLeadingUnderscore backports prereqs Ryde subr inlined =head1 NAME Perl::Critic::Policy::Compatibility::ConstantLeadingUnderscore - new enough "constant" module for leading underscores =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks that if you have a constant with a leading underscore, use constant _FOO ... # leading underscore on name then you explicitly declare C or C, or higher, since C before that did not allow leading underscores. use constant _FOO => 123; # bad use 5.006; use constant _FOO => 123; # ok use constant 1.02; use constant _FOO => 123; # ok use constant 1.02 _FOO => 123; # ok The idea is to avoid trouble in code which might run on Perl 5.005, or might in principle still run there. On that basis this policy is under the "compatibility" theme (see L). Asking for the new enough module C is suggested, since it's the module feature which is required and the code might then still run on Perl 5.005 or earlier if the user has a suitable C from CPAN. =head2 Details A version declaration must be before the first leading underscore, so it's checked before the underscore is attempted (and would give an error). use constant _FOO => 123; # bad use 5.006; A C for the Perl version is not enough since C is at C time, before plain code. require 5.006; # doesn't run early enough use constant _FOO => 123; # bad But a C within a C block is ok (a past style, still found occasionally). BEGIN { require 5.006 } use constant _FOO => 123; # ok BEGIN { require 5.006; and_other_setups ...; } use constant _FOO => 123; # ok Currently C pays no attention to any conditionals within the C, it assumes any C there always runs. It might be tricked by obscure tests but hopefully anything like that is rare or does the right thing anyway. A quoted version number like use constant '1.02'; # no good is no good, only a bare number is recognised by the C statement as a version check. A string like that in fact goes through to C as a name to define, and which it will reject. Leading underscores in a multi-constant hash are not flagged, since new enough C to have multi-constants is new enough to have underscores. See L for multi-constants version check. use constant { _FOO => 1 }; # not checked Leading double-underscore is disallowed by all versions of C. That's not reported by this policy since the code won't run at all. use constant __FOO => 123; # not allowed by any constant.pm =head2 Drawbacks Explicitly adding required version numbers in the code can be irritating, especially if other things you're doing only run on 5.6 up anyway. But declaring what code needs is accurate, it allows maybe for backports of modules, and explicit versions can be grepped out to create or check F or F prereqs. As always, if you don't care about this or if you only ever use Perl 5.6 anyway then you can disable C from your F<.perlcriticrc> in the usual way (see L), [-Compatibility::ConstantLeadingUnderscore] =head1 OTHER WAYS TO DO IT It's easy to write your own constant subr and it can have any name at all (anything acceptable to Perl), bypassing the sanity checks or restrictions in C. Only the C<()> prototype is a bit obscure. sub _FOO () { return 123 } The key benefit of subs like this, whether from C or explicitly, is that the value is inlined and can be constant-folded in an arithmetic expression etc (see L). print 2*_FOO; # folded to 246 at compile-time The purpose of a leading underscore is normally a hint that the sub is meant to be private to the module and/or its friends. If you don't need the constant folding then a C scalar is even more private, being invisible to anything outside relevant scope, my $FOO = 123; # more private # ... do_something ($FOO); # nothing to constant-fold anyway The scalar returned from C subs is flagged read-only, which might prevent accidental mis-use when passed around. The C module gives the same effect on variables. If you have C then it's just a flag too (no performance penalty on using the value). use Readonly; Readonly::Scalar my $FOO => 123; =head1 SEE ALSO L, L, L, L, L L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Compatibility/ConstantPragmaHash.pm0000644000175000017500000002030014017115126025174 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::Compatibility::ConstantPragmaHash; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp::Utils; use version (); # but don't import qv() # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM; use constant default_themes => qw(pulp compatibility); use constant applies_to => 'PPI::Document'; my $perl_ok_version = version->new('5.008'); my $constant_ok_version = version->new('1.03'); sub violates { my ($self, $elem, $document) = @_; my @violations; my $perlver; # a "version" object my $modver; # a "version" object my $aref = $document->find ('PPI::Statement::Include') || return; # if no includes at all foreach my $inc (@$aref) { $inc->type eq 'use' || ($inc->type eq 'require' && Perl::Critic::Pulp::Utils::elem_in_BEGIN($inc)) || next; if (my $ver = $inc->version) { # "use 5.008" etc perl version $ver = version->new ($ver); if (! defined $perlver || $ver > $perlver) { $perlver = $ver; if ($perlver >= $perl_ok_version) { # adequate perl version demanded, stop here last; } } next; } ($inc->module||'') eq 'constant' || next; if (my $ver = Perl::Critic::Pulp::Utils::include_module_version ($inc)) { ### $ver # PPI::Token::Number::Float $ver = version->new ($ver->content); if (! defined $modver || $ver > $modver) { $modver = $ver; if ($modver >= $constant_ok_version) { # adequate "constant" version demanded, stop here last; } } } if (_use_constant_is_multi ($inc)) { push @violations, $self->violation ("'use constant' with multi-constant hash requires perl 5.8 or constant 1.03 (at this point have " . (defined $perlver ? "perl $perlver" : "no perl version") . (defined $modver ? ", constant $modver)" : ", no constant version)"), '', $inc); } } return @violations; } # $inc is a PPI::Statement::Include with type "use" and module "constant". # Return true if it has a multi-constant hash as its argument like # "use constant { X => 1 };" # # The plain "use constant { x=>1 }" comes out as # # PPI::Statement::Include # PPI::Token::Word 'use' # PPI::Token::Word 'constant' # PPI::Structure::Constructor { ... } # PPI::Statement # PPI::Token::Word 'x' # PPI::Token::Operator '=>' # PPI::Token::Number '1' # # Or as of PPI 1.203 with a version number "use constant 1.03 { x=>1 }" is # different # # PPI::Statement::Include # PPI::Token::Word 'use' # PPI::Token::Word 'constant' # PPI::Token::Number::Float '1.03' # PPI::Structure::Block { ... } # PPI::Statement # PPI::Token::Word 'x' # PPI::Token::Operator '=>' # PPI::Token::Number '1' # sub _use_constant_is_multi { my ($inc) = @_; my $arg = Perl::Critic::Pulp::Utils::include_module_first_arg ($inc) || return 0; # empty "use constant" or version "use constant 1.05" return ($arg->isa('PPI::Structure::Constructor') # without version number || $arg->isa('PPI::Structure::Block')); # with version number } 1; __END__ =for stopwords multi-constant CPAN perl ok ConstantPragmaHash backports prereqs Ryde =head1 NAME Perl::Critic::Policy::Compatibility::ConstantPragmaHash - new enough "constant" module for multiple constants =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It requires that when you use the hash style multiple constants of C that you explicitly declare either Perl 5.8 or C 1.03 or higher. use constant { AA => 1, BB => 2 }; # bad use 5.008; use constant { CC => 1, DD => 2 }; # ok use constant 1.03; use constant { EE => 1, FF => 2 }; # ok use constant 1.03 { GG => 1, HH => 2 }; # ok The idea is to keep you from using the multi-constant feature in code which might run on Perl 5.6, or might in principle still run there. On that basis this policy is under the "compatibility" theme (see L). If you declare C then the code can still run on Perl 5.6 and perhaps earlier if the user gets a suitably newer C module from CPAN. Or of course for past compatibility just don't use the hash style at all! =head2 Details A version declaration must be before the first multi-constant, so it's checked before the multi-constant is attempted and gives an obscure error. use constant { X => 1, Y => 2 }; # bad use 5.008; A C for the perl version is not enough since C is at C time, before plain code. require 5.008; # doesn't run early enough use constant { X => 1, Y => 2 }; # bad But a C within a C block is ok (a past style, still found occasionally). BEGIN { require 5.008 } use constant { X => 1, Y => 2 }; # ok BEGIN { require 5.008; and_other_setups ...; } use constant { X => 1, Y => 2 }; # ok Currently C pays no attention to any conditionals within the C, it assumes any C there always runs. It could be tricked by some obscure tests but hopefully anything like that is rare or does the right thing anyway. A quoted version number like use constant '1.03'; # no good is no good, only a bare number is recognised by C and acted on by ConstantPragmaHash. A string like that goes through to C as if a name to define (which you'll see it objects to as soon as you try run it). =head2 Drawbacks Explicitly adding required version numbers in the code can be irritating, especially if other things you're doing only run on 5.8 up anyway. But declaring what code needs is accurate, it allows maybe for backports of modules, and explicit versions can be grepped out to create or check F or F prereqs. As always if you don't care about this or if you only ever use Perl 5.8 anyway then you can disable C from your F<.perlcriticrc> in the usual way (see L), [-Compatibility::ConstantPragmaHash] =head1 SEE ALSO L, L, L, L, L L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Compatibility/PodMinimumVersion.pm0000644000175000017500000001466614017115126025115 0ustar gggg# Copyright 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::Compatibility::PodMinimumVersion; use 5.006; use strict; use warnings; # 1.084 for Perl::Critic::Document highest_explicit_perl_version() use Perl::Critic::Policy 1.084; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp::Utils; # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; use constant supported_parameters => ({ name => 'above_version', description => 'Check only things above this version of Perl.', behavior => 'string', parser => \&Perl::Critic::Pulp::Utils::parameter_parse_version, }); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; use constant default_themes => qw(pulp compatibility); use constant applies_to => 'PPI::Document'; # but actually Pod::MinimumVersion is a hard dependency at the moment ... sub initialize_if_enabled { my ($self, $config) = @_; # when Pod::MinimumVersion is available return (eval { require Pod::MinimumVersion; 1 } || 0); } sub violates { my ($self, $document) = @_; ### $self # whichever of highest_explicit_perl_version() or "above_version" is greater my $above_version = $self->{'_above_version'}; if (defined (my $doc_version = $document->highest_explicit_perl_version)) { if (! defined $above_version || $doc_version > $above_version) { $above_version = $doc_version; } } my $str = $document->serialize; my $pmv = Pod::MinimumVersion->new (string => $str, above_version => $above_version, one_report_per_version => 1, ); my @reports = $pmv->reports; @reports = sort {$a->{'version'} <=> $b->{'version'}} @reports; return map { my $report = $_; my $violation = $self->violation ("Pod requires perl $report->{'version'} due to: $report->{'why'}.", '', $document); Perl::Critic::Pulp::Utils::_violation_override_linenum ($violation, $str, $report->{'linenum'}); } @reports; } package Perl::Critic::Pulp::PodMinimumVersionViolation; use base 'Perl::Critic::Violation'; sub location { my ($self) = @_; my $offset = ($self->{_Pulp_linenum_offset} || 0); my @location = @{$self->SUPER::location()}; $location[0] += $offset; # line if ($#location >= 3) { $location[3] += $offset; # logical line, new in ppi 1.205 } return \@location; } 1; __END__ =for stopwords CPAN config Ryde =head1 NAME Perl::Critic::Policy::Compatibility::PodMinimumVersion - check Perl version declared against POD features used =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It checks that the POD features you use don't exceed your target Perl version as indicated by C etc. =for ProhibitVerbatimMarkup allow next 3 use 5.005; =pod C<< something >> # bad, double angles needs 5.006 POD doesn't affect how the code runs, so this policy is low severity, and under the "compatibility" theme (see L). See L|Pod::MinimumVersion> for the POD version checks applied. The key idea is for example when targeting Perl 5.005 you avoid things like double-angles SE EE>>, since C in 5.005 didn't support them. It may be possible to get newer versions of the POD translators from CPAN, but whether they run on an older Perl and whether you want to require that of users is another matter. Adding the sort of C etc to declare a target Perl can be a bit tedious. The config option below lets you set a base version you use. As always if you don't care at all about this sort of thing you can disable the policy from your F<.perlcriticrc> in the usual way (see L), [-Compatibility::PodMinimumVersion] =head2 C Policy The C policy asks you to use the Ctarget|displayE> style always. That feature is new in Perl 5.005 and will be reported by C unless you've got C or higher or set C below. =head1 CONFIGURATION =over 4 =item C (version string, default none) Report only things about Perl versions above this. The string is anything the L|version> module understands. For example if you always use Perl 5.6 or higher then set [Compatibility::PodMinimumVersion] above_version = 5.006 The effect is that all POD features up to and including Perl 5.6 are allowed, only things above that will be reported (and still only those exceeding any C in the file). =back =head1 SEE ALSO L, L, L L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Compatibility/ProhibitUnixDevNull.pm0000644000175000017500000001246014017115126025375 0ustar gggg# Copyright 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::Compatibility::ProhibitUnixDevNull; use 5.006; use strict; use warnings; use List::Util; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp; our $VERSION = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; use constant default_themes => qw(pulp bugs); use constant applies_to => qw(PPI::Token::Quote PPI::Token::QuoteLike::Words); # See Perl_do_openn() for IsSPACE allowed leading, after mode and trailing. # No layers in a two-arg open, only < > >> etc. # use constant _DEV_NULL_RE => qr{^\s* (\+?(<|>>?)\s*)? /dev/null \s*$ }sxo; my %equality_operators = (eq => 1, ne => 1); sub violates { my ($self, $elem, $document) = @_; if ($elem->isa('PPI::Token::QuoteLike::Words')) { return unless List::Util::first {$_ eq '/dev/null'} $elem->literal; } else { # PPI::Token::Quote my $str = $elem->string; return unless $str =~ _DEV_NULL_RE; # Allow ... eq 'dev/null' or 'dev/null' eq ... # # Could think about the filetest operators too. -e '/dev/null' is # probably a portability check, but believe still better to have # File::Spec->devnull there. # foreach my $adj ($elem->sprevious_sibling, $elem->snext_sibling) { if ($adj && $adj->isa('PPI::Token::Operator') && $equality_operators{$adj}) { return; } } } return $self->violation ('For maximum portability use File::Spec->devnull instead of "/dev/null"', '', $elem); } 1; __END__ =for stopwords filename backticks Ryde =head1 NAME Perl::Critic::Policy::Compatibility::ProhibitUnixDevNull - don't use explicit /dev/null =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It ask you to not to use filename =over F =back explicitly, but instead Cdevnull()> for maximum portability across operating systems. This policy is under the C theme (see L) on the basis that even if you're on a Unix system now you never know where your code might travel in the future. C is new in C version 0.8, so you should require that version (it's included in Perl 5.6.0 and up). The checks for F are unsophisticated. A violation is reported for any string C, possibly with an C style mode part, and any C containing C. open my $fh, '< /dev/null'; # bad do_something ("/dev/null"); # bad foreach my $file (qw(/dev/null /etc/passwd)) # bad String comparisons are allowed because they're not uses of F as such but likely some sort of cross-platform check. if ($f eq '/dev/null') { ... } # ok return ($f ne '>/dev/null'); # ok F as just part of a string is allowed, including things like backticks and C. print "Flames to /dev/null please\n" # ok system ('rmdir /foo/bar >/dev/null 2>&1'); # ok $hi = `echo hi is a good idea in such command strings depends what sort of shell you reach with that command and how much of Unix it might emulate on a non-Unix system. =head2 Disabling If you only ever use a system with F or if everything else you write is hopelessly wedded to Unix anyway then you can disable C from your F<.perlcriticrc> in the usual way (see L), [-Compatibility::ProhibitUnixDevNull] =head1 SEE ALSO L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Compatibility/PerlMinimumVersionAndWhy.pm0000644000175000017500000010525614017115126026404 0ustar gggg# Copyright 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::Compatibility::PerlMinimumVersionAndWhy; use 5.006; use strict; use warnings; use version (); # but don't import qv() # 1.208 for PPI::Token::QuoteLike::Regexp get_modifiers() use PPI 1.208; # 1.084 for Perl::Critic::Document highest_explicit_perl_version() use Perl::Critic::Policy 1.084; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils qw(parse_arg_list); use Perl::Critic::Pulp::Utils; # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; use constant supported_parameters => ({ name => 'above_version', description => 'Check only things above this version of Perl.', behavior => 'string', parser => \&Perl::Critic::Pulp::Utils::parameter_parse_version, }, { name => 'skip_checks', description => 'Version checks to skip (space separated list).', behavior => 'string', }); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; use constant default_themes => qw(pulp compatibility); use constant applies_to => 'PPI::Document'; sub initialize_if_enabled { my ($self, $config) = @_; # ask that Perl::MinimumVersion is available and still has its # undocumented %CHECKS to mangle below eval { require Perl::MinimumVersion; scalar %Perl::MinimumVersion::CHECKS } or return 0; _setup_extra_checks(); } sub violates { my ($self, $document) = @_; my %skip_checks; if (defined (my $skip_checks = $self->{_skip_checks})) { @skip_checks{split / /, $self->{_skip_checks}} = (); # hash slice } my $pmv = Perl::MinimumVersion->new ($document); my $config_above_version = $self->{'_above_version'}; my $explicit_version = _highest_explicit_perl_version($document); my @violations; foreach my $check (sort keys %Perl::MinimumVersion::CHECKS) { next if exists $skip_checks{$check}; next if $check eq '_constant_hash'; # better by ConstantPragmaHash # next if $check =~ /_pragmas$/; # usually impossible in earlier next if $check =~ /_modules$/; # wrong for dual-life stuff my $check_version = $Perl::MinimumVersion::CHECKS{$check}; next if (defined $explicit_version && $check_version <= $explicit_version); next if (defined $config_above_version && $check_version <= $config_above_version); ### $check my $elem = do { no warnings 'redefine'; local *PPI::Node::find_any = \&PPI::Node::find_first; $pmv->$check } || next; # require Data::Dumper; # print Data::Dumper::Dumper($elem); # print $elem->location,"\n"; push @violations, $self->violation ("$check requires $check_version", '', $elem); } return @violations; } my $v5010 = version->new('5.010'); # Some controversy: # https://github.com/Perl-Critic/Perl-Critic/issues/270 # http://elliotlovesperl.com/2009/05/17/the-problem-with-modernperl/ # sub _highest_explicit_perl_version { my ($document) = @_; ### _highest_explicit_perl_version() ... my $ver = $document->highest_explicit_perl_version; if ($ver < $v5010 && Perl::Critic::Policy::Compatibility::Gtk2Constants::_document_uses_module($document,'Modern::Perl')) { ### increase to 5.010 ... $ver = $v5010; } return $ver; } #--------------------------------------------------------------------------- # Crib note: $document->find_first wanted func returning undef means the # element is unwanted and also don't descend into its sub-elements. # sub _setup_extra_checks { # 5.12.0 my $v5012 = version->new('5.012'); $Perl::MinimumVersion::CHECKS{_Pulp__keys_of_array} = $v5012; $Perl::MinimumVersion::CHECKS{_Pulp__values_of_array} = $v5012; $Perl::MinimumVersion::CHECKS{_Pulp__each_of_array} = $v5012; # 5.10.0 unless (eval { Perl::MinimumVersion->VERSION(1.28); 1 }) { # fixed in 1.28 up $Perl::MinimumVersion::CHECKS{_Pulp__5010_magic__fix} = $v5010; $Perl::MinimumVersion::CHECKS{_Pulp__5010_operators__fix} = $v5010; } $Perl::MinimumVersion::CHECKS{_Pulp__5010_qr_m_propagate_properly} = $v5010; $Perl::MinimumVersion::CHECKS{_Pulp__5010_stacked_filetest} = $v5010; # 5.8.0 my $v5008 = version->new('5.008'); $Perl::MinimumVersion::CHECKS{_Pulp__fat_comma_across_newline} = $v5008; $Perl::MinimumVersion::CHECKS{_Pulp__eval_line_directive_first_thing} = $v5008; # 5.6.0 my $v5006 = version->new('5.006'); $Perl::MinimumVersion::CHECKS{_Pulp__exists_subr} = $v5006; $Perl::MinimumVersion::CHECKS{_Pulp__exists_array_elem} = $v5006; $Perl::MinimumVersion::CHECKS{_Pulp__delete_array_elem} = $v5006; $Perl::MinimumVersion::CHECKS{_Pulp__0b_number} = $v5006; $Perl::MinimumVersion::CHECKS{_Pulp__syswrite_length_optional} = $v5006; $Perl::MinimumVersion::CHECKS{_Pulp__open_my_filehandle} = $v5006; $Perl::MinimumVersion::CHECKS{_Pulp__var_method_without_parens} = $v5006; # 5.005 my $v5005 = version->new('5.005'); unless (exists $Perl::MinimumVersion::CHECKS{_bareword_ends_with_double_colon}) { # adopted into Perl::MinimumVersion 1.28 $Perl::MinimumVersion::CHECKS{_Pulp__bareword_double_colon} = $v5005; } $Perl::MinimumVersion::CHECKS{_Pulp__my_list_with_undef} = $v5005; # 5.004 my $v5004 = version->new('5.004'); $Perl::MinimumVersion::CHECKS{_Pulp__special_literal__PACKAGE__} = $v5004; $Perl::MinimumVersion::CHECKS{_Pulp__use_version_number} = $v5004; $Perl::MinimumVersion::CHECKS{_Pulp__for_loop_variable_using_my} = $v5004; $Perl::MinimumVersion::CHECKS{_Pulp__arrow_coderef_call} = $v5004; $Perl::MinimumVersion::CHECKS{_Pulp__sysseek_builtin} = $v5004; # UNIVERSAL.pm $Perl::MinimumVersion::CHECKS{_Pulp__UNIVERSAL_methods_5004} = $v5004; $Perl::MinimumVersion::CHECKS{_Pulp__UNIVERSAL_methods_5010} = $v5010; # pack()/unpack() $Perl::MinimumVersion::CHECKS{_Pulp__pack_format_5004} = $v5004; $Perl::MinimumVersion::CHECKS{_Pulp__pack_format_5006} = $v5006; $Perl::MinimumVersion::CHECKS{_Pulp__pack_format_5008} = $v5008; $Perl::MinimumVersion::CHECKS{_Pulp__pack_format_5010} = $v5010; } { # Perl::MinimumVersion prior to 1.28 had 'PPI::Token::Operator' and # 'PPI::Token::Magic' swapped between the respective operator/magic tests package Perl::MinimumVersion; use vars qw(%MATCHES); sub _Pulp__5010_operators__fix { shift->Document->find_first (sub { $_[1]->isa('PPI::Token::Operator') and $MATCHES{_perl_5010_operators}->{$_[1]->content}; } ); } sub _Pulp__5010_magic__fix { shift->Document->find_first (sub { $_[1]->isa('PPI::Token::Magic') and $MATCHES{_perl_5010_magic}->{$_[1]->content}; } ); } } sub Perl::MinimumVersion::_Pulp__5010_qr_m_propagate_properly { my ($pmv) = @_; ### _Pulp__5010_qr_m_propagate_properly() check ... $pmv->Document->find_first (sub { my ($document, $elem) = @_; $elem->isa('PPI::Token::QuoteLike::Regexp') || return 0; my %modifiers = $elem->get_modifiers; ### content: $elem->content ### modifiers: \%modifiers return ($modifiers{'m'} ? 1 : 0); }); } # new in 5.010 as described in perlfunc.pod sub Perl::MinimumVersion::_Pulp__5010_stacked_filetest { my ($pmv) = @_; ### _Pulp__5010_stacked_filetest() check ... $pmv->Document->find_first (sub { my ($document, $elem) = @_; return (_elem_is_filetest_operator($elem) # -X && ($elem = $elem->snext_sibling) # has a next sibling && _elem_is_filetest_operator($elem) # -X ? 1 : 0); }); } # $elem is a PPI::Element # Return true if it's a -X operator. sub _elem_is_filetest_operator { my ($elem) = @_; return ($elem->isa('PPI::Token::Operator') && $elem =~ /^-./); } #----------------------------------------------------------------------------- # foo \n => fat comma across newline new in 5.8.0 # extra code in 5.8 toke.c under comment "not a keyword" checking for => # sub Perl::MinimumVersion::_Pulp__fat_comma_across_newline { my ($pmv) = @_; ### _Pulp__fat_comma_across_newline() check $pmv->Document->find_first (sub { my ($document, $elem) = @_; ### elem: "$elem" if ($elem->isa('PPI::Token::Operator') && $elem->content eq '=>') { my ($prev, $saw_newline) = sprevious_sibling_and_newline($elem); ### prev: "$prev" ### $saw_newline if ($saw_newline && $prev && $prev->isa('PPI::Token::Word') && $prev !~ /^-/ # -foo self-quotes && ! Perl::Critic::Utils::is_method_call($prev)) { # ->foo return 1; # found } } return 0; # continue searching }); } sub sprevious_sibling_and_newline { my ($elem) = @_; ### sprevious_sibling_and_newline() my $saw_newline; for (;;) { $elem = $elem->previous_sibling || last; if ($elem->isa('PPI::Token::Whitespace')) { $saw_newline ||= ($elem->content =~ /\n/); } elsif ($elem->isa('PPI::Token::Comment')) { $saw_newline = 1; } else { last; } } return ($elem, $saw_newline); } #----------------------------------------------------------------------------- # delete $array[0] and exists $array[0] new in 5.6.0 # two functions so the "exists" or "delete" appears in the check name # sub Perl::MinimumVersion::_Pulp__exists_array_elem { my ($pmv) = @_; ### _Pulp__exists_array_elem() check return _exists_or_delete_array_elem ($pmv, 'exists'); } sub Perl::MinimumVersion::_Pulp__delete_array_elem { my ($pmv) = @_; ### _Pulp__delete_array_elem() check return _exists_or_delete_array_elem ($pmv, 'delete'); } sub _exists_or_delete_array_elem { my ($pmv, $which) = @_; ### _exists_or_delete_array_elem() $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && $elem eq $which && Perl::Critic::Utils::is_function_call($elem) && _arg_is_array_elem($elem->snext_sibling)) { return 1; } else { return 0; } }); } sub _arg_is_array_elem { my ($elem) = @_; ### _arg_is_array_elem: "$elem" (($elem = _descend_through_lists($elem)) && $elem->isa('PPI::Token::Symbol') && $elem->raw_type eq '$' && ($elem = $elem->snext_sibling)) or return 0; my $ret = 0; for (;;) { if ($elem->isa('PPI::Structure::Subscript')) { # adjacent $x{key}[123] $ret = ($elem->start eq '['); } elsif ($elem->isa('PPI::Structure::List')) { # $x[0]->() function call return 0; } elsif ($elem->isa('PPI::Token::Operator') && $elem eq '->') { # subscript ->, continue } else { # anything else below -> precedence, stop last; } $elem = $elem->snext_sibling || last; } ### $ret return $ret; } sub _descend_through_lists { my ($elem) = @_; while ($elem && ($elem->isa('PPI::Structure::List') || $elem->isa('PPI::Statement::Expression') || $elem->isa('PPI::Statement'))) { $elem = $elem->schild(0); } return $elem; } # exists(&subr) new in 5.6.0 # sub Perl::MinimumVersion::_Pulp__exists_subr { my ($pmv) = @_; ### _Pulp__exists_subr() check $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && $elem eq 'exists' && Perl::Critic::Utils::is_function_call($elem) && ($elem = _symbol_or_list_symbol($elem->snext_sibling)) && $elem->symbol_type eq '&') { return 1; } else { return 0; } }); } # 0b110011 binary literals new in 5.6.0 # sub Perl::MinimumVersion::_Pulp__0b_number { my ($pmv) = @_; ### _Pulp__0b_number() check $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Number::Binary')) { return 1; } else { return 0; } }); } # syswrite($fh,$str) length optional in 5.6.0 # sub Perl::MinimumVersion::_Pulp__syswrite_length_optional { my ($pmv) = @_; ### _Pulp__syswrite_length_optional() check $pmv->Document->find_first (sub { my ($document, $elem) = @_; my @args; if ($elem->isa('PPI::Token::Word') && $elem eq 'syswrite' && Perl::Critic::Utils::is_function_call($elem) && (@args = Perl::Critic::Utils::parse_arg_list($elem)) == 2) { return 1; } else { return 0; } }); } # open(my $fh,...) auto-creating a handle glob new in 5.6.0 # my %open_func = (open => 1, opendir => 1, pipe => 2, socketpair => 2, sysopen => 1, socket => 1, accept => 1); sub Perl::MinimumVersion::_Pulp__open_my_filehandle { my ($pmv) = @_; ### _Pulp__open_my_filehandle() check $pmv->Document->find_first (sub { my ($document, $elem) = @_; my ($count, $my, $fh); unless ($elem->isa('PPI::Token::Word') && ($count = $open_func{$elem}) && Perl::Critic::Utils::is_function_call($elem)) { return 0; } $my = $elem->snext_sibling; # with parens is # PPI::Token::Word 'open' # PPI::Structure::List ( ... ) # PPI::Statement::Variable # PPI::Token::Word 'my' # PPI::Token::Symbol '$fh' # PPI::Token::Operator ',' # if ($my->isa('PPI::Structure::List')) { $my = $my->schild(0) || return 0; } if ($my->isa('PPI::Statement::Variable')) { $my = $my->schild(0) || return 0; } foreach (1 .. $count) { ### my: "$my" if (_is_uninitialized_my($my)) { return 1; } $my = _skip_to_next_arg($my) || last; } return 0; }); } sub _is_uninitialized_my { my ($my) = @_; my ($fh, $after); return ($my->isa('PPI::Token::Word') && $my eq 'my' && ($fh = $my->snext_sibling) && $fh->isa('PPI::Token::Symbol') && $fh->symbol_type eq '$' && ! (($after = $fh->snext_sibling) && $after->isa('PPI::Token::Operator') && $after eq '=')); } # FIXME: is this enough for prototyped funcalls in the args? sub _skip_to_next_arg { my ($elem) = @_; for (;;) { my $next = $elem->snext_sibling || return undef; if ($elem->isa('PPI::Token::Operator') && $Perl::Critic::Pulp::Utils::COMMA{$elem}) { return $next; } $elem = $next; } } # $obj->$method; omit parens new in 5.6.0 # previously required parens like $obj->$method(); # sub Perl::MinimumVersion::_Pulp__var_method_without_parens { my ($pmv) = @_; ### _Pulp__var_method_without_parens() ... $pmv->Document->find_first (sub { my ($document, $elem) = @_; my $next; if ($elem->isa('PPI::Token::Symbol') && $elem->symbol_type eq '$' && Perl::Critic::Utils::is_method_call($elem) # must be followed by "()" for earlier perl, so if not then it # means 5.6.0 required && ! (($next = $elem->snext_sibling) && $next->isa('PPI::Structure::List'))) { return 1; } else { return 0; } }); } #----------------------------------------------------------------------------- # Foo::Bar:: bareword new in 5.005 # generally a compile-time syntax error in 5.004 # sub Perl::MinimumVersion::_Pulp__bareword_double_colon { my ($pmv) = @_; ### _Pulp__bareword_double_colon() check $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && $elem =~ /::$/) { return 1; } else { return 0; } }); } # my ($x, undef, $y), undef in a my() list new in 5.005 # usually something like my (undef, $x) = @values # sub Perl::MinimumVersion::_Pulp__my_list_with_undef { my ($pmv) = @_; ### _Pulp__my_list_with_undef() check $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && $elem eq 'my' && _list_contains_undef ($elem->snext_sibling)) { return 1; } else { return 0; } }); } # $elem is a PPI::Element or false # return true if it's a list and there's an 'undef' element in the list # # PPI::Structure::List ( ... ) # PPI::Statement::Expression # PPI::Token::Symbol '$x' # PPI::Token::Operator ',' # PPI::Token::Word 'undef' # PPI::Token::Operator ',' # PPI::Token::Symbol '$y' # # Or for multi-parens: my ((undef)) with PPI::Statement in the middle # # PPI::Structure::List ( ... ) # PPI::Statement # PPI::Structure::List ( ... ) # PPI::Statement::Expression # PPI::Token::Word 'undef' # sub _list_contains_undef { my ($elem) = @_; ### _list_contains_undef: "$elem" $elem or return; $elem->isa('PPI::Structure::List') or return; my @search = ($elem); while (@search) { $elem = pop @search; ### elem: "$elem" if ($elem->isa('PPI::Structure::List') || $elem->isa('PPI::Statement::Expression') || $elem->isa('PPI::Statement')) { push @search, $elem->schildren; } elsif ($elem->isa('PPI::Token::Word') && $elem eq 'undef') { return 1; } } } #----------------------------------------------------------------------------- # pack() / unpack() # # Nothing new in 5.12, nothing new in 5.14. sub Perl::MinimumVersion::_Pulp__pack_format_5004 { my ($pmv) = @_; # w - BER integer return _pack_format ($pmv, qr/w/); } sub Perl::MinimumVersion::_Pulp__pack_format_5006 { my ($pmv) = @_; # Z - asciz # q - signed quad # Q - unsigned quad # ! - native size # / - counted string # # - comment return _pack_format ($pmv, qr{[ZqQ!/#]}); } sub Perl::MinimumVersion::_Pulp__pack_format_5008 { my ($pmv) = @_; # F - NV # D - long double # j - IV # J - UV # ( - group # [ - in a repeat count like "L[20]" return _pack_format ($pmv, qr/[FDjJ([]/); } sub Perl::MinimumVersion::_Pulp__pack_format_5010 { my ($pmv) = @_; # < - little endian # > - big endian return _pack_format ($pmv, qr/[<>]/); } # Think nothing new in 5012 ... my %pack_func = (pack => 1, unpack => 1); sub _pack_format { my ($pmv, $regexp) = @_; require Perl::Critic::Policy::Miscellanea::TextDomainPlaceholders; $pmv->Document->find_first (sub { my ($document, $elem) = @_; $elem->isa ('PPI::Token::Word') || return 0; $pack_func{$elem->content} || return 0; Perl::Critic::Utils::is_function_call($elem) || return 0; my @args = parse_arg_list ($elem); my $format_arg = $args[0]; ### format: @$format_arg my ($str, $any_vars) = Perl::Critic::Policy::Miscellanea::TextDomainPlaceholders::_arg_string ($format_arg, $document); ### $str ### $any_vars if ($any_vars) { return 0; } return ($str =~ $regexp); }); } # 5.004 new __PACKAGE__ # sub Perl::MinimumVersion::_Pulp__special_literal__PACKAGE__ { my ($pmv) = @_; ### _Pulp__special_literal__PACKAGE__ $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && $elem eq '__PACKAGE__' && ! Perl::Critic::Utils::is_hash_key($elem)) { return 1; } else { return 0; } }); } # 5.004 new "use VERSION" # # "use MODULE VERSION" is not as easy, fairly sure it depends whether the # target module uses Exporter.pm or not since the VERSION part is passed to # import() and Exporter.pm checks it. # sub Perl::MinimumVersion::_Pulp__use_version_number { my ($pmv) = @_; ### _Pulp__use_version_number $pmv->Document->find_first (sub { my ($document, $elem) = @_; $elem->isa('PPI::Statement::Include') or return 0; $elem->type eq 'use' or return 0; if ($elem->version ne '') { # empty string '' for not a "use VERSION" return 1; } else { return 0; } }); } # 5.004 new "foreach my $i" lexical loop variable # sub Perl::MinimumVersion::_Pulp__for_loop_variable_using_my { my ($pmv) = @_; ### _Pulp__for_loop_variable_using_my $pmv->Document->find_first (sub { my ($document, $elem) = @_; $elem->isa('PPI::Statement::Compound') or return 0; $elem->type eq 'foreach' or return 0; my $second = $elem->schild(1) || return 0; $second->isa('PPI::Token::Word') or return 0; if ($second eq 'my') { return 1; } else { return 0; } }); } # 5.004 new "$foo->(PARAMS)" coderef call # sub Perl::MinimumVersion::_Pulp__arrow_coderef_call { my ($pmv) = @_; ### _Pulp__arrow_coderef_call $pmv->Document->find_first (sub { my ($document, $elem) = @_; $elem->isa('PPI::Token::Operator') or return 0; ### operator: "$elem" $elem eq '->' or return 0; $elem = $elem->snext_sibling || return 0; ### next: "$elem" if ($elem->isa('PPI::Structure::List')) { return 1; } else { return 0; } }); } # 5.004 new sysseek() function # # Crib note: the prototype() function is newly documented in 5.004 but # existed earlier, or something. Might have returned a trailing "\0" in # 5.003. # sub Perl::MinimumVersion::_Pulp__sysseek_builtin { my ($pmv) = @_; ### _Pulp__sysseek_builtin $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && ($elem eq 'sysseek' || $elem eq 'CORE::sysseek') && Perl::Critic::Utils::is_function_call ($elem)) { return 1; } else { return 0; } }); } #--------------------------------------------------------------------------- # UNIVERSAL.pm methods # { my $methods = { VERSION => 1, isa => 1, can => 1 }; sub Perl::MinimumVersion::_Pulp__UNIVERSAL_methods_5004 { my ($pmv) = @_; ### _Pulp__UNIVERSAL_methods_5004() ... return _any_method($pmv,$methods); } } { my $methods = { DOES => 1 }; sub Perl::MinimumVersion::_Pulp__UNIVERSAL_methods_5010 { my ($pmv) = @_; ### _Pulp__UNIVERSAL_methods_5010() ... return _any_method($pmv,$methods); } } sub _any_method { my ($pmv, $hash) = @_; $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && $hash->{$elem} && Perl::Critic::Utils::is_method_call ($elem)) { return 1; } else { return 0; } }); } #------------------------------------------------------------------------------ # keys @foo, values @foo, each @foo new in 5.12.0 # sub Perl::MinimumVersion::_Pulp__keys_of_array { my ($pmv) = @_; return _keys_etc_of_array ($pmv, 'keys'); } sub Perl::MinimumVersion::_Pulp__values_of_array { my ($pmv) = @_; return _keys_etc_of_array ($pmv, 'values'); } sub Perl::MinimumVersion::_Pulp__each_of_array { my ($pmv) = @_; return _keys_etc_of_array ($pmv, 'each'); } sub _keys_etc_of_array { my ($pmv, $which) = @_; ### _keys_etc_of_array() ... $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && $elem eq $which && Perl::Critic::Utils::is_function_call($elem) && _arg_is_array($elem->snext_sibling)) { return 1; } else { return 0; } }); } sub _arg_is_array { my ($elem) = @_; ### _arg_is_array "$elem" $elem = _descend_through_lists($elem) || return 0; if ($elem->isa('PPI::Token::Symbol') && $elem->raw_type eq '@') { return 1; } if ($elem->isa('PPI::Token::Cast') && $elem eq '@') { return 1; } return 0; } #------------------------------------------------------------------------------ # eval '#line ...' with the #line the very first thing, # the #line doesn't take effect until 5.008, # in 5.006 need a blank line or something first { my $initial_line_re = qr/^#[ \t]*line/; sub Perl::MinimumVersion::_Pulp__eval_line_directive_first_thing { my ($pmv) = @_; ### _Pulp__eval_line_directive_first_thing() ... $pmv->Document->find_first (sub { my ($document, $elem) = @_; if ($elem->isa('PPI::Token::Word') && $elem eq 'eval' && Perl::Critic::Utils::is_function_call($elem) && ($elem = $elem->snext_sibling) && ($elem = _descend_through_lists($elem))) { ### eval of: "$elem" if ($elem->isa('PPI::Token::Quote')) { if ($elem->string =~ $initial_line_re) { return 1; } } elsif ($elem->isa('PPI::Token::HereDoc')) { my ($str) = $elem->heredoc; # first line if ($str =~ $initial_line_re) { return 1; } } } return 0; }); } } #--------------------------------------------------------------------------- # generic # if $elem is a symbol or a List of a symbol then return that symbol elem, # otherwise return an empty list # sub _symbol_or_list_symbol { my ($elem) = @_; if ($elem->isa('PPI::Structure::List')) { $elem = $elem->schild(0) || return; $elem->isa('PPI::Statement::Expression') || return; $elem = $elem->schild(0) || return; } $elem->isa('PPI::Token::Symbol') || return; return $elem; } #--------------------------------------------------------------------------- 1; __END__ =for stopwords config MinimumVersion Pragma CPAN prereq multi-constant concats pragma endianness filehandle asciz builtin Ryde no-args parens BER lexically-scoped =head1 NAME Perl::Critic::Policy::Compatibility::PerlMinimumVersionAndWhy - explicit Perl version for features used =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It requires that you have an explicit C etc for the Perl syntax features you use, as determined by L|Perl::MinimumVersion>. use 5.010; # the // operator is new in perl 5.010 print $x // $y; # ok If you don't have the C module then nothing is reported. Certain nasty hacks are used to extract reasons and locations from C. This policy is under the "compatibility" theme (see L). Its best use is when it picks up things like C or C which are only available in a newer Perl than you meant to target. An explicit C can be a little tedious, but has the advantage of making it clear what's needed (or supposed to be needed) and it gives a good error message if run on an older Perl. =head2 Disabling The config options below let you limit how far back to go. Or if you don't care at all about this sort of thing you can always disable the policy completely from your F<~/.perlcriticrc> file in the usual way (see L), [-Compatibility::PerlMinimumVersionAndWhy] =head2 MinimumVersion Mangling Some mangling is applied to what C normally reports (as of its version 1.28). =over 4 =item * A multi-constant hash with the L|constant> module is not reported, since that's covered better by L. =item * Module requirements for things like C are dropped, since you might get a back-port from CPAN etc and the need for a module is better expressed in a distribution "prereq". But pragma modules like C are still reported. They're normally an interface to a feature new in the Perl version it comes with and can't be back-ported. (See L below too.) =back =head2 MinimumVersion Extras The following extra checks are added to C. =over =item 5.12 for =over =item * new C, C and C =back =item 5.10 for =over =item * C, since "m" modifier doesn't propagate correctly on a C until 5.10 =item * C<-e -f -x> stacked filetest operators. =item * C new C> and C> endianness. =item * new C method C =back =item 5.8 for =over =item * new C> fat comma quoting across a newline For earlier Perl C ended up a function call. It's presumed such code is meant to quote in the 5.8 style, and thus requires 5.8 or higher. =item * C with C<#line> the very first thing In earlier Perl a C<#line> as the very first thing in an C doesn't take effect. Adding a blank line so it's not first is enough. =item * C new C native NV, C long double, C IV, C UV, C<()> group, C<[]> repeat count =back =item 5.6 for =over =item * new C, C and C =item * new C<0b110011> binary number literals =item * new C etc auto-creation of filehandle =item * C length parameter optional =item * C$method> no-args call without parens For earlier Perl a no-args call to a method named in a variable must be C$method()>. The parens are optional in 5.6 up. =item * C new C asciz, C,C quads, C native size, C counted string, C<#> comment =back =item 5.005 for =over =item * new C double-colon package name quoting =item * new C, using C as a dummy in a C list =back =item 5.004 for =over =item * new C Perl version check through C. For earlier Perl it can be C etc =item * new C<__PACKAGE__> special literal =item * new C lexical loop variable =item * new C<$coderef-E()> call with C<-E> =item * new C builtin function =item * C new C BER integer =item * new C with C, C and C methods =back =back C and C format strings are only checked if they're literal strings or here-documents without interpolations, or C<.> operator concats of those. The C report concerns a misfeature fixed in perl 5.10.0 (see L). In earlier versions a regexp like C<$re = qr/^x/m> within another regexp like C loses the C attribute from C<$re>, changing the interpretation of the C<^> (and C<$> similarly). Forms like C<(\A|\n)> are a possible workaround, though are uncommon so may be a little obscure. C asks for C in all cases so if think you want that then you probably want Perl 5.10 or up for the fix too. =head2 C C is taken to mean Perl 5.10. This is slightly experimental and in principle the actual minimum it implies is forever rising, and even now could be more, or depends on it date argument scheme. Maybe if could say its actual current desire then an installed version could be queried. =head1 CONFIGURATION =over 4 =item C (version string, default none) Set a minimum version of Perl you always use, so that reports are only about things higher than this and higher than what the document declares. The value is anything the L|version> module can parse. [Compatibility::PerlMinimumVersionAndWhy] above_version = 5.006 For example if you always use Perl 5.6 and set 5.006 like this then you can have C package variables without an explicit C. =item C (list of check names, default none) Skip the given MinimumVersion checks (a space separated list). The check names are shown in the violation message and come from C. For example, [Compatibility::PerlMinimumVersionAndWhy] skip_checks = _some_thing _another_thing This can be used for checks you believe are wrong, or where the compatibility matter only affects limited circumstances which you understand. The check names are likely to be a moving target, especially the Pulp additions. Unknown checks in the list are quietly ignored. =back =head1 OTHER NOTES C is reported as a Perl 5.6 feature since the lexically-scoped fine grain warnings control it gives is new in that version. If targeting earlier versions then it's often enough to drop C, ensure your code runs cleanly under S<< C >>, and leave it to applications to use C<-w> (or set C<$^W>) if they desire. C offers a C for earlier Perl, but it's not lexical, instead setting C<$^W> globally. In a script this might be an alternative to S> (per L), but in a module it's probably not a good idea to change global settings. The C methods C, C, C or C might in principle be implemented explicitly by a particular class, but it's assumed that's not so and that any call to those requires the respective minimum Perl version. =head1 SEE ALSO L, L L, which is similar, but compares against a Perl version configured in your F<~/.perlcriticrc> rather than a version in the document. L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Compatibility/Gtk2Constants.pm0000644000175000017500000002507014017115126024164 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::Compatibility::Gtk2Constants; 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 is_method_call); use Perl::Critic::Pulp::Utils; # uncomment this to run the ### lines #use Smart::Comments; our $VERSION = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM; use constant default_themes => qw(pulp bugs); use constant applies_to => qw(PPI::Token::Word PPI::Token::Symbol); my $v1_190 = version->new('1.190'); my $v1_210 = version->new('1.210'); my $v1_211 = version->new('1.211'); my %constants = ( GTK_PRIORITY_RESIZE => ['Gtk2',$v1_190], GDK_PRIORITY_EVENTS => ['Gtk2',$v1_190], GDK_PRIORITY_REDRAW => ['Gtk2',$v1_190], GDK_CURRENT_TIME => ['Gtk2',$v1_190], EVENT_PROPAGATE => ['Gtk2',$v1_210], EVENT_STOP => ['Gtk2',$v1_210], GTK_PATH_PRIO_LOWEST => ['Gtk2',$v1_211], GTK_PATH_PRIO_GTK => ['Gtk2',$v1_211], GTK_PATH_PRIO_APPLICATION => ['Gtk2',$v1_211], GTK_PATH_PRIO_THEME => ['Gtk2',$v1_211], GTK_PATH_PRIO_RC => ['Gtk2',$v1_211], GTK_PATH_PRIO_HIGHEST => ['Gtk2',$v1_211], SOURCE_CONTINUE => ['Glib',$v1_210], SOURCE_REMOVE => ['Glib',$v1_210], ); sub violates { my ($self, $elem, $document) = @_; my $elem_str; if ($elem->isa('PPI::Token::Symbol')) { $elem->symbol_type eq '&' or return; # only &SOURCE_REMOVE is for us $elem_str = substr $elem->symbol, 1; } else { $elem_str = $elem->content; } my ($elem_qualifier, $elem_basename) = _qualifier_and_basename ($elem_str); # quick lookup excludes names not of interest my $constinfo = $constants{$elem_basename} || return; my ($const_module, $want_version) = @$constinfo; if ($elem->isa('PPI::Token::Symbol') || is_function_call ($elem)) { if (defined $elem_qualifier) { if ($elem_qualifier ne $const_module) { return; # from another module, eg. Foo::Bar::SOURCE_REMOVE } } else { if (! _document_uses_module ($document, $const_module)) { return; # unqualified SOURCE_REMOVE, and no mention of Glib, etc } } } elsif (is_method_call ($elem)) { if (defined $elem_qualifier) { # an oddity like Some::Where->Gtk2::SOURCE_REMOVE if ($elem_qualifier ne $const_module) { return; # from another module, Some::Where->Foo::Bar::SOURCE_REMOVE } } else { # unqualified method name, eg. Some::Thing->SOURCE_REMOVE my $class_elem = $elem->sprevious_sibling->sprevious_sibling; if (! $class_elem || ! $class_elem->isa('PPI::Token::Word')) { # ignore oddities like $foo->SOURCE_REMOVE return; } my $class_name = $class_elem->content; if ($class_name ne $const_module) { # some other class, eg. Foo::Bar->SOURCE_REMOVE return; } } } else { # not a function or method call return; } my $got_version = _highest_explicit_module_version ($document,$const_module); if (defined $got_version && ref $got_version) { if ($got_version >= $want_version) { return; } } return $self->violation ("$elem requires $const_module $want_version, but " . (defined $got_version && ref $got_version ? "version in file is $got_version" : "no version specified in file"), '', $elem); } # "Foo" return (undef, "Foo") # "Foo::Bar::Quux" return ("Foo::Bar", "Quux") # sub _qualifier_and_basename { my ($str) = @_; return ($str =~ /(?:(.*)::)?(.*)/); } # return true if $document has a "use" or "require" 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; ### all incs: @$aref ### matched incs: @incs if (! @incs) { return undef; } my @vers = map { _include_module_version_with_exporter($_) } @incs; ### versions: @vers @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__ =for stopwords Gtk2 Ryde =head1 NAME Perl::Critic::Policy::Compatibility::Gtk2Constants - new enough Gtk2 version for its constants =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It requires that if you use certain constant subs from L|Gtk2> and L|Glib> then you must explicitly have a C of a high enough version of those modules. use Gtk2 1.160; ... return Gtk2::EVENT_PROPAGATE; # bad use Gtk2 1.200 ':constants'; ... return GDK_CURRENT_TIME; # good The following C constants are checked, GTK_PRIORITY_RESIZE # new in Gtk2 1.200 (devel 1.190) GDK_PRIORITY_EVENTS GDK_PRIORITY_REDRAW GDK_CURRENT_TIME EVENT_PROPAGATE # new in Gtk2 1.220 (devel 1.210) EVENT_STOP GTK_PATH_PRIO_LOWEST # new in Gtk2 1.220 (devel 1.211) GTK_PATH_PRIO_GTK GTK_PATH_PRIO_APPLICATION GTK_PATH_PRIO_THEME GTK_PATH_PRIO_RC GTK_PATH_PRIO_HIGHEST and the following C constants SOURCE_CONTINUE # new in Glib 1.220 (devel 1.210) SOURCE_REMOVE The idea is to keep you from using the constants without a new enough C or C. Of course there's a huge number of other things you might do that also require a new enough version, but these constants tripped me up a few times. The exact version numbers above and demanded are development versions. You're probably best off rounding up to a "stable" one like 1.200 or 1.220. As always if you don't care about this and in particular if for instance you only ever use Gtk2 1.220 or higher anyway then you can disable C from your F<.perlcriticrc> in the usual way (see L), [-Compatibility::Gtk2Constants] =head2 Constant Forms Constants are recognised as any of for instance EVENT_PROPAGATE Gtk2::EVENT_PROPAGATE Gtk2->EVENT_PROPAGATE &EVENT_PROPAGATE &Gtk2::EVENT_PROPAGATE When there's a class name given it's checked, so that other uses of say C aren't picked up. Some::Other::Thing::EVENT_PROPAGATE # ok Some::Other::Thing->EVENT_PROPAGATE # ok &Some::Other::Thing::EVENT_PROPAGATE # ok When there's no class name, then it's only assumed to be Gtk2 or Glib when the respective module has been included. use Something::Else; EVENT_PROPAGATE # ok use Gtk2 ':constants'; EVENT_PROPAGATE # bad In the latter form there's no check for C<:constants> or explicit import in the C, it's assumed that if you've used Gtk2 then C means that one no matter how the imports might be arranged. =head1 SEE ALSO L, L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Miscellanea/0002755000175000017500000000000015071066561020535 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/Policy/Miscellanea/TextDomainUnused.pm0000644000175000017500000001457614017115127024336 0ustar gggg# Copyright 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::Miscellanea::TextDomainUnused; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils qw(is_function_call); our $VERSION = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; use constant default_themes => qw(pulp cosmetic); use constant applies_to => 'PPI::Document'; sub violates { my ($self, $elem, $document) = @_; my $use = _find_use_locale_textdomain($document) || return; if (_any_calls_locale_textdomain($document)) { return; } if (_any_vars_locale_textdomain($document)) { return; } if (_any_strings_locale_textdomain($document)) { return; } return $self->violation ('Locale::TextDomain imported, but none of its functions used', '', $use); } # return a PPI::Statement::Include which is a "use" or "require" of # Locale::TextDomain, or return false if there's no such sub _find_use_locale_textdomain { my ($document) = @_; my $aref = $document->find ('PPI::Statement::Include') || return; # if no includes at all return List::Util::first { $_->type ne 'no' && ($_->module||'') eq 'Locale::TextDomain' } @$aref; } # The following qw() copied from @Locale::TextDomain::EXPORT of libintl-perl # 1.18, with $__ %__ moved to %vars below. __p and friends are new in 1.17, # but no need to check that. # my %funcs = map {($_=>1)} qw(__ __x __n __nx __xn __p __px __np __npx N__ N__n N__p N__np); # and also as full names "Locale::TextDomain::__" foreach (keys %funcs) { $funcs{"Locale::TextDomain::$_"} = 1; } # return true if $document has any of the Locale::TextDomain functions used, # like __() etc sub _any_calls_locale_textdomain { my ($document) = @_; my $aref = $document->find ('PPI::Token::Word') || return; # if no word tokens at all return List::Util::first { $funcs{$_->content} && is_function_call($_) } @$aref; } ## no critic (RequireInterpolationOfMetachars) my %vars = ('$__' => 1, '%__' => 1); ## use critic sub _any_vars_locale_textdomain { my ($document) = @_; my $aref = $document->find ('PPI::Token::Symbol') || return; # if no symbols at all return List::Util::first { $vars{$_->symbol} } @$aref; } sub _any_strings_locale_textdomain { my ($document) = @_; my $aref = $document->find ('PPI::Token::Quote') || return; # if no strings at all return List::Util::first { ($_->isa('PPI::Token::Quote::Interpolate') || $_->isa('PPI::Token::Quote::Double')) && $_->string =~ /\$__(\W|$)/ } @$aref; } 1; __END__ =for stopwords textdomain perlcritic TextDomainUnused eg TextDomain PPI Ryde =head1 NAME Perl::Critic::Policy::Miscellanea::TextDomainUnused - check for Locale::TextDomain imported but unused =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It reports when you have L|Locale::TextDomain> like use Locale::TextDomain ('MyMessageDomain'); but then don't use any of its functions or variables __ __x __n __nx __xn __p __px __np __npx N__ N__n N__p N__np %__ $__ C is not needed when not used, but it's also not actively harmful so this policy is only low severity and under the C theme (see L). The check is good if you've got C as boilerplate code in most of your program, but in some modules it's unused. You can remove it entirely from non-interactive modules, or comment it out from modules which might have messages but don't yet. The best thing picked up is when your boilerplate has got into a programmatic module which shouldn't say anything at the user level. The saving from removing unused C is modest, just some imports and a hash entry holding the "textdomain" for the package. It's easy to imagine a general kind of "module imported but unused" policy check, but in practice its hard for perlcritic to know the automatic imports of every module, and quite a few modules have side-effects, so this TextDomainUnused policy just starts with one case of an unused include. =head2 Interpolated Variables The variables C<%__> and C<$__> are recognised in double-quote interpolated strings just by looking for a C<$__> somewhere in the string, eg. print "*** $__{'A Message'} ***\n"; # ok It's not hard to trick the recognition with escapes, or a hash slice style, but in general taking any C<$__> to be a TextDomain use is close enough. (Perhaps in the future PPI will do a full parse of interpolated expressions.) =head1 SEE ALSO L, L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Miscellanea/TextDomainPlaceholders.pm0000644000175000017500000003144114017115127025466 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::Miscellanea::TextDomainPlaceholders; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils qw(is_function_call parse_arg_list interpolate); # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; 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'; my %funcs = (__x => 1, __nx => 1, __xn => 1, __px => 1, __npx => 1); sub violates { my ($self, $elem, $document) = @_; my $funcname = $elem->content; $funcname =~ s/^Locale::TextDomain:://; $funcs{$funcname} || return; ### TextDomainPlaceholders: $elem->content is_function_call($elem) || return; my @violations; # The arg crunching bits assume one parsed expression results in one arg, # which is not true if the expressions are an array, a hash, or a function # call returning multiple values. The one-arg-one-value assumption is # reasonable on the whole though. # # In the worst case you'd have to take any function call value part like # "foo => FOO()" to perhaps return multiple values -- which would # completely defeat testing of normal cases, so don't want to do that. # # ENHANCE-ME: One bit that could be done though is to recognise a %foo arg # as giving an even number of values, so keyword checking could continue # past it. # each element of @args is an arrayref containing PPI elements making up # the arg my @args = parse_arg_list ($elem); ### got total arg count: scalar(@args) if ($funcname =~ /p/) { # msgctxt context arg to __p, __npx shift @args; } # one format to __x, two to __nx and other "n" funcs my @format_args = splice @args, 0, ($funcname =~ /n/ ? 2 : 1); if ($funcname =~ /n/) { # count arg to __nx and other "n" funcs my $count_arg = shift @args; if (! $count_arg || do { # if it looks like a keyword symbol foo=> or 'foo' etc my ($str, $any_vars) = _arg_word_or_string ($count_arg, $document); ($str =~ /^[[:alpha:]_]\w*$/ && ! $any_vars) }) { push @violations, $self->violation ("Probably missing 'count' argument to $funcname", '', $count_arg->[0] || $elem); } } ### got data arg count: scalar(@args) my $args_any_vars = 0; my %arg_keys; while (@args) { my $arg = shift @args; my ($str, $any_vars) = _arg_word_or_string ($arg, $document); $args_any_vars ||= $any_vars; ### arg: @$arg ### $str ### $any_vars if (! $any_vars) { $arg_keys{$str} = $arg; } shift @args; # value part } my %format_keys; my $format_any_vars; foreach my $format_arg (@format_args) { my ($format_str, $any_vars) = _arg_string ($format_arg, $document); $format_any_vars ||= $any_vars; while ($format_str =~ /\{(\w+)\}/g) { my $format_key = $1; ### $format_key $format_keys{$format_key} = 1; if (! $args_any_vars && ! exists $arg_keys{$format_key}) { push @violations, $self->violation ("Format key '$format_key' not in arg list", '', $format_arg->[0] || $elem); } } } if (! $format_any_vars) { foreach my $arg_key (keys %arg_keys) { if (! exists $format_keys{$arg_key}) { my $arg = $arg_keys{$arg_key}; push @violations, $self->violation ("Argument key '$arg_key' not used by format" . (@format_args == 1 ? '' : 's'), '', $arg->[0] || $elem); } } } ### total violation count: scalar(@violations) return @violations; } sub _arg_word_or_string { my ($arg, $document) = @_; if (@$arg == 1 && $arg->[0]->isa('PPI::Token::Word')) { return ("$arg->[0]", 0); } else { return _arg_string ($arg, $document); } } # $arg is an arrayref of PPI::Element which are an argument # if it's a constant string or "." concat of such then # return ($str, $any_vars) where $str is the string content # and $any_vars is true if there's any variables to be interpolated in $str # sub _arg_string { my ($arg, $document) = @_; ### _arg_string() ... my @elems = @$arg; my $ret = ''; my $any_vars = 0; while (@elems) { my $elem = shift @elems; if ($elem->isa('PPI::Token::Quote')) { my $str = $elem->string; if ($elem->isa('PPI::Token::Quote::Double') || $elem->isa('PPI::Token::Quote::Interpolate')) { # ENHANCE-ME: use $arg->interpolations() when available also on # PPI::Token::Quote::Interpolate $any_vars ||= _string_any_vars ($str); } $ret .= $str; } elsif ($elem->isa('PPI::Token::HereDoc')) { my $str = join('',$elem->heredoc); if ($elem =~ /`$/) { $str = ' '; # no idea what running backticks might produce $any_vars = 1; } elsif ($elem !~ /'$/) { # explicit "HERE" or default HERE expand vars $any_vars ||= _string_any_vars ($str); } $ret .= $str; } elsif ($elem->isa('PPI::Token::Number')) { ### number can work like a constant string ... $ret .= $elem->content; } elsif ($elem->isa('PPI::Token::Word')) { ### word ... my $next; if ($elem eq '__PACKAGE__') { $ret .= _elem_package_name($elem); } elsif ($elem eq '__LINE__') { ### logical line: $elem->location->[3] $ret .= $elem->location->[3]; # logical line using any #line directives } elsif ($elem eq '__FILE__') { my $filename = _elem_logical_filename($elem,$document); if (! defined $filename) { $filename = 'unknown-filename.pl'; } ### $filename $ret .= $filename; } elsif (($next = $elem->snext_sibling) && $next->isa('PPI::Token::Operator') && $next eq '=>') { ### word quoted by => ... $ret .= $elem->content; last; } else { ### some function call or something ... return ('', 2); } } else { ### some variable or expression or something ... return ('', 2); } if (! @elems) { last; } my $op = shift @elems; if (! ($op->isa('PPI::Token::Operator') && $op eq '.')) { # something other than "." concat return ('', 2); } } return ($ret, $any_vars); } # $str is the contents of a "" or qq{} string # return true if it has any $ or @ interpolation forms sub _string_any_vars { my ($str) = @_; return ($str =~ /(^|[^\\])(\\\\)*[\$@]/); } # $elem is a PPI::Element # Return the name (a string) of its containing package, or "main" if not # under any package statement. # sub _elem_package_name { my ($elem) = @_; if (my $packelem = Perl::Critic::Pulp::Utils::elem_package($elem)) { if (my $name = $packelem->namespace) { return $name; } } return 'main'; } # As per perlsyn.pod, except \2 instead of \g2 since \g only in perl 5.10 up. # Is this in a module somewhere? my $line_directive_re = qr/^\# \s* line \s+ (\d+) \s* (?:\s("?)([^"]+)\2)? \s* $/xm; # $elem is a PPI::Element # Return its logical filename (a string). # This is from a "#line" comment directive, or the $document filename if no # such. # sub _elem_logical_filename { my ($elem, $document) = @_; ### _elem_logical_filename(): "$elem" my $filename; $document->find_first (sub { my ($doc, $e) = @_; # ### comment: (ref $e)." ".$e->content if ($e == $elem) { ### not found before target elem, stop ... return undef; } if ($e->isa('PPI::Token::Comment') && $e->content =~ $line_directive_re) { $filename = $3; ### found line directive: $filename } return 0; # continue }); if (defined $filename) { return $filename; } else { ### not found, use document: $document->filename return $document->filename; } } 1; __END__ =for stopwords args arg Gettext Charset runtime Ryde unexpanded =head1 NAME Perl::Critic::Policy::Miscellanea::TextDomainPlaceholders - check placeholder names in Locale::TextDomain calls =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It checks the placeholder arguments in format strings to the following functions from C. __x __nx __xn __px __npx Calls with a key missing from the args or args unused by the format are reported. print __x('Searching for {data}', # bad datum => 123); print __nx('Read one file', 'Read {num} files', # bad $n, count => 123); This is normally a mistake, so this policy is under the "bugs" theme (see L). An error can easily go unnoticed because (as of Locale::TextDomain version 1.16) a placeholder without a corresponding arg goes through unexpanded and any extra args are ignored. The way Locale::TextDomain parses the format string allows anything between S<< C<< { } >> >> as a key, but for the purposes of this policy only symbols (alphanumeric plus "_") are taken to be a key. This is almost certainly what you'll want to use, and it's then possible to include literal braces in a format string without tickling this policy all the time. (Symbol characters are per Perl C<\w>, so non-ASCII is supported, though the Gettext manual in node "Charset conversion" recommends message-IDs should be ASCII-only.) =head1 Partial Checks If the format string is not a literal then it might use any args, so all are considered used. # ok, 'datum' might be used __x($my_format, datum => 123); Literal portions of the format are still checked. # bad, 'foo' not present in args __x("{foo} $bar", datum => 123); Conversely if the args have some non-literals then they could be anything, so everything in the format string is considered present. # ok, $something might be 'world' __x('hello {world}', $something => 123); But again if some args are literals they can be checked. # bad, 'blah' is not used __x('hello {world}', $something => 123, blah => 456); If there's non-literals both in the format and in the args then nothing is checked, since it could all match up fine at runtime. =head2 C<__nx> Count Argument A missing count argument to C<__nx>, C<__xn> and C<__npx> is sometimes noticed by this policy. For example, print __nx('Read one file', 'Read {numfiles} files', numfiles => $numfiles); # bad If the count argument looks like a key then it's reported as a probable mistake. This is not the main aim of this policy but it's done because otherwise no violations would be reported at all. (The next argument would be the key, and normally being an expression it would be assumed to fulfill the format strings at runtime.) =head1 SEE ALSO L, L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/CodeLayout/0002755000175000017500000000000015071066561020370 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/Policy/CodeLayout/ProhibitFatCommaNewline.pm0000644000175000017500000002031114017115126025422 0ustar gggg# Copyright 2009, 2010, 2011, 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 . # use strict; # $, = "\n"; # sub foo { # return 123; # } # sub x { # my %h = (-foo # => 'abc'); # print %h # } # x(); package Perl::Critic::Policy::CodeLayout::ProhibitFatCommaNewline; use 5.006; use strict; use warnings; use version (); # but don't import qv() use Perl::Critic::Utils; # 1.084 for Perl::Critic::Document highest_explicit_perl_version() use Perl::Critic::Policy 1.084; use base 'Perl::Critic::Policy'; our $VERSION = 100; # 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 bugs); use constant applies_to => ('PPI::Token::Operator'); my $v5008 = version->new('5.008'); sub violates { my ($self, $elem, $document) = @_; $elem->content eq '=>' or return; # some other operator my $prev = $elem->sprevious_sibling || return; if (! $prev->isa('PPI::Token::Word')) { ### previous not a word, so => acts as a plain comma, ok ... return; } if (! _elems_any_newline_between ($prev, $elem)) { ### no newline before =>, ok ... return; } my $word = $prev->content; # A builtin is never quoted by newline fat comma. # PPI 1.213 gives a word "-print" where it should be a negate of a # print(), so check the word "sans dash". if (Perl::Critic::Utils::is_perl_builtin(_sans_dash($word))) { return $self->violation ("Fat comma after newline doesn't quote Perl builtin \"$word\"", '', $elem); } # In 5.8 up words are quoted by newline fat comma, so ok. if (defined (my $doc_version = $document->highest_explicit_perl_version)) { if ($doc_version >= $v5008) { return; } } # In 5.6 and earlier newline fat comma doesn't quote. return $self->violation ("Fat comma after newline doesn't quote preceding bareword \"$word\"", '', $elem); } # return $str stripped of a leading "-", if it has one sub _sans_dash { my ($str) = @_; $str =~ s/^-//; return $str; } # $from and $to are PPI::Element # Return true if there's a "\n" newline anywhere in between those elements, # not including either $from or $to themselves. sub _elems_any_newline_between { my ($from, $to) = @_; if ($from == $to) { return 0; } for (;;) { $from = $from->next_sibling || return 0; if ($from == $to) { return 0; } if ($from =~ /\n/) { return 1; } } } 1; __END__ =for stopwords Ryde bareword builtin Builtin builtins Builtins eg parens =head1 NAME Perl::Critic::Policy::CodeLayout::ProhibitFatCommaNewline - keep a fat comma on the same line as its quoted word =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It reports a newline between a fat comma and preceding bareword for Perl builtins, my %h = (caller # bad, builtin called as a function => 'abc'); And for all words when targeting Perl 5.6 and earlier, use 5.006; my %h = (foo # bad, all words in perl 5.6 and earlier => 'def'); When there's a newline between the word and the fat comma like this the word executes as a function call (builtins always, and also user defined in Perl 5.6 and earlier), giving its return value rather than a word string. Such a return value is probably not what was intended and on that basis this policy is under the "bugs" theme and medium severity (see L). =head2 Builtins Perl builtin functions with a newline always execute and give their return value rather than a the quoted word. my %h = (print # bad, builtin print() executes => "abc"); # %h is key "1" value "abc" The builtin is called with no arguments and that might provoke a warning from some, but others like C will quietly run. Dashed builtin names such as C<-print> are also function calls, with a negate operator. my %h = (-print # bad, print() call and negate => "123"); # h is key "-1" value "123" For the purposes of this policy the builtins are C from L. It's possible this is more builtins than the particular Perl in use, but guarding against all will help if going to a newer Perl in the future. =head2 Non-Builtins In Perl 5.6 and earlier all words C execute as a function call when there's a newline before the fat comma. sub foo { return 123 } my %h = (foo => "def"); # in Perl 5.6 and earlier %h is key "123" value "def" Under C an error is thrown if no such function, in the usual way. A word builtin is a function call if it exists (with a warning about being interpreted that way), or a bareword if not. This policy prohibits all words with newline before fat comma when targeting Perl 5.6 or earlier. This means either an explicit C or smaller, or no such minimum C at all. One subtle way an executing word with newline before fat comma can go undetected (in 5.6 and earlier still) is an accidental redefinition of a constant, use constant FOO => "blah"; use constant FOO => "some value"; # makes a constant subr called blah (in Perl 5.6) C might reject some return values from C, eg. a number, but a string like "blah" here quietly expands and creates a constant C. The difference between Perl 5.6 and later Perl is that in 5.6 the parser only looked as far as a newline for a possible quoting C<=E> fat comma. In Perl 5.8 and later for non-builtins the lookahead continues beyond any newlines and comments. For Perl builtins the behaviour is the same, in all versions the lookahead stops at the newline. =head2 Avoiding Problems Putting the fat comma on the same line as the word ensures it quotes in all cases. my %h = (-print => # ok, fat comma on same line quotes "123"); If for layout purposes you do want a newline then the suggestion is to give a string or perhaps a parenthesized expression since that doesn't rely on the C<=E> fat comma quoting. A fat comma can still emphasize a key/value pair. my %h = ('print' # ok, string => 123); Alternately if instead a function call is really what's intended (builtin or otherwise) then parens can be used in the normal way to ensure it's a call (as per L the rule being "if it looks like a function, it is a function"). my %h = (foo() # ok, function call => 123); =head2 Disabling As always if you don't care about this then you can disable C from your F<.perlcriticrc> in the usual way (see L), [-CodeLayout::ProhibitFatCommaNewline] =head1 SEE ALSO L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2011, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/CodeLayout/ProhibitIfIfSameLine.pm0000644000175000017500000001340514017115126024652 0ustar gggg# 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 . # perlcritic -s ProhibitIfIfSameLine /usr/share/perl5/Pod/Simple.pm # preceded by "return" so actually ok # perlcritic -s ProhibitIfIfSameLine /usr/share/perl5/Tk/AbstractCanvas.pm # two ifs one line package Perl::Critic::Policy::CodeLayout::ProhibitIfIfSameLine; use 5.006; use strict; use warnings; use Perl::Critic::Utils; use base 'Perl::Critic::Policy'; our $VERSION = 100; # 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 bugs); use constant applies_to => ('PPI::Statement::Compound'); my %compound_type_is_if = (if => 1, unless => 1); sub violates { my ($self, $elem, $document) = @_; ### ProhibitIfIfSameLine elem: "$elem" ### type: $elem->type unless (_compound_statement_is_if($elem)) { ### not an "if" ... return; } if (_elems_any_separator ($elem->child(0), $elem->schild(0))) { ### leading whitespace in elem itself, so ok ... return; } my $prev = $elem->sprevious_sibling || return; unless ($prev->isa('PPI::Statement::Compound') && $compound_type_is_if{$prev->type}) { ### not preceded by an "if", so ok ... return; } if (_elems_any_separator ($prev->next_sibling, $elem)) { ### newlines after previous statement, so ok ... return; } return $self->violation ('Put a newline in "} if (x)" so it doesn\'t look like possible \"elsif\"', '', $elem); } # $elem is a PPI::Statement::Compound # Return true if it's an "if" statement. # Note this is not simply $elem->type eq "if", since type "if" includes # "unless" statements, but _compound_statement_is_if() is true only on "if" # statements. # sub _compound_statement_is_if { my ($elem) = @_; return (($elem->schild(0)||'') eq 'if'); } # Return true if there is a suitable separator in $from or its following # elements up to $to, but not including $to. # sub _elems_any_separator { my ($from, $to) = @_; for (;;) { if ($from == $to) { return 0; } if ($from =~ /\n/ || $from->isa('PPI::Statement::Null')) { return 1; } $from = $from->next_sibling || return 0; } } 1; __END__ =for stopwords Ryde =head1 NAME Perl::Critic::Policy::CodeLayout::ProhibitIfIfSameLine - don't put if after if on same line =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you to not to write an C statement on the same line as a preceding C. if ($x) { ... } if ($y) { # bad ... } if ($x) { ... } elsif ($y) { # was "elsif" intended ? ... } The idea is that an C in the layout of an C may be either a mistake or will be confusing to a human reader. On that basis this policy is under the "bugs" theme and medium severity (see L). =head2 Unless An C is treated the same. Perl allows C and so the same potential confusion with an C layout arises. unless ($x) { ... } if ($y) { # bad ... } unless ($x) { ... } elsif ($y) { # maybe meant to be "elsif" like this ? ... } Whether C is a good idea at all is another matter. Sometimes it suits a combination of conditions. =head2 Statement Modifiers This policy only applies to a statement followed by a statement. An C as a statement modifier is not affected. It's usual to put that on the same line as the statement it modifies. do { ... } if ($x); # ok, statement modifier =head2 All One Line Two C statements written on the same line will trigger the policy. if(1){one;} if(2){two;} # bad Perhaps there could be an exception or option when both statements are entirely on the one line, or some such, for code which is trying to be compact. =head2 Disabling As always if you don't care about this then you can disable C from your F<.perlcriticrc> (see L), [-CodeLayout::ProhibitIfIfSameLine] =head1 SEE ALSO L, L 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/CodeLayout/RequireFinalSemicolon.pm0000644000175000017500000004737714017115126025174 0ustar gggg# Copyright 2010, 2011, 2012, 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 . package Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon; use 5.006; use strict; use warnings; use List::Util; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp; use Perl::Critic::Pulp::Utils; # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; use constant supported_parameters => ({ name => 'except_same_line', description => 'Whether to allow no semicolon at the end of blocks with the } closing brace on the same line as the last statement.', behavior => 'boolean', default_string => '1', }, { name => 'except_expression_blocks', description => 'Whether to allow no semicolon at the end of do{} expression blocks.', behavior => 'boolean', default_string => '1', }); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; use constant default_themes => qw(pulp cosmetic); use constant applies_to => 'PPI::Structure::Block'; sub violates { my ($self, $elem, $document) = @_; ### RequireFinalSemicolon elem: $elem->content if (_block_is_hash_constructor($elem) != 0) { ### hash constructor, or likely so, stop ... return; } my $block_last = $elem->schild(-1) || return; # empty block doesn't need a semi ### block_last: ref($block_last),$block_last->content $block_last->isa('PPI::Statement') || do { ### last in block is not a PPI-Statement ... return; }; if (_elem_statement_no_need_semicolon($block_last)) { return; } { my $bstat_last = $block_last->schild(-1) || return; # statement shouldn't be empty, should it? ### bstat_last in statement: ref($bstat_last),$bstat_last->content if (_elem_is_semicolon($bstat_last)) { ### has final semicolon, ok ... return; } } if ($self->{'_except_expression_blocks'}) { if (_block_is_expression($elem)) { ### do expression, ok return; } ### not a do{} expression } # if don't have final brace then this option doesn't apply as there's no # final brace to be on the same line if ($self->{'_except_same_line'} && $elem->complete) { if (! _newline_in_following_sibling($block_last)) { ### no newline before close, ok return; } } my $report_at = $block_last->next_sibling || $block_last; return $self->violation ('Put semicolon ; on last statement in a block', '', $report_at); } # return true if $elem is a PPI::Statement subclass which doesn't require a # terminating ";" sub _elem_statement_no_need_semicolon { my ($elem) = @_; return ($elem->isa('PPI::Statement::Compound') # for(){} etc || $elem->isa('PPI::Statement::Sub') # nested named sub || $elem->isa('PPI::Statement::Given') || $elem->isa('PPI::Statement::When') || $elem->isa('PPI::Statement::End') # __END__ || $elem->isa('PPI::Statement::Null') # ; || $elem->isa('PPI::Statement::UnmatchedBrace') # stray } || _elem_is_try_block($elem) ); } my %postfix_loops = (while => 1, until => 1); my %prefix_expressions = (do => 1, map => 1, grep => 1, sort => 1, map { $_ => 1, "List::Util::$_" => 1 } qw( reduce any all none notall first pairfirst pairgrep pairmap ), map { $_ => 1, "List::Pairwise::$_" => 1 } qw( mapp map_pairwise grepp grep_pairwise firstp first_pairwise lastp last_pairwise ), ); # $elem is a PPI::Structure::Block. # return 1 definitely a hash # 0 definitely a block # -1 not certain # # PPI 1.212 tends to be give PPI::Structure::Block for various things which # are actually anon hash constructors and ought to be # PPI::Structure::Constructor. For example, # # return bless { x => 123 }; # return \ { x => 123 }; # # _block_is_hash_constructor() tries to recognise some of those blocks which # are actually hash constructors, so as not to apply the final semicolon # rule to hash constructors. # my %word_is_block = (sub => 1, do => 1, map => 1, grep => 1, sort => 1, # from Try.pm, TryCatch.pm, Try::Tiny prototypes, etc try => 1, catch => 1, finally => 1, # List::Util first() etc are not of interest to # RequireFinalSemicolon but ProhibitDuplicateHashKeys # shares this code so recognise them for it. %prefix_expressions, ); sub _block_is_hash_constructor { my ($elem) = @_; ### _block_is_hash_constructor(): ref($elem), "$elem" # if (_block_starts_semi($elem)) { # ### begins with ";", block is correct ... # return 0; # } if (_block_has_multiple_statements($elem)) { ### contains one or more ";", block is correct ... return 0; } if (my $prev = $elem->sprevious_sibling) { ### prev: ref($prev), "$prev" if ($prev->isa('PPI::Structure::Condition')) { ### prev condition, block is correct ... return 0; } if ($prev->isa('PPI::Token::Cast')) { if ($prev eq '\\') { ### ref cast, is a hash ... return 1; } else { ### other cast, block is correct (or a variable name) ... return 0; } } if ($prev->isa('PPI::Token::Operator')) { ### prev operator, is a hash ... return 1; } if (! $prev->isa('PPI::Token::Word')) { ### prev not a word, not sure ... return -1; } if ($word_is_block{$prev}) { # "sub { ... }" # "do { ... }" ### do/sub/map/grep/sort, block is correct ... return 0; } if (! ($prev = $prev->sprevious_sibling)) { # "bless { ... }" # "return { ... }" etc # ENHANCE-ME: notice List::Util first{} and other prototyped things ### nothing else preceding, likely a hash ... return -1; } ### prev prev: "$prev" if ($prev eq 'sub') { # "sub foo {}" ### named sub, block is correct ... return 0; } # "word bless { ... }" # "word return { ... }" etc ### other word preceding, likely a hash ... return -1; } my $parent = $elem->parent || do { ### umm, at toplevel, is a block ... return 0; }; if ($parent->isa('PPI::Statement::Compound') && ($parent = $parent->parent) && ( $parent->isa('PPI::Structure::List') || $parent->isa('PPI::Structure::Constructor'))) { ### in a list or arrayref, is a hashref ... # This catches # ppidump "[{%args}]" # which comes out (from PPI 1.270) as # # PPI::Structure::Constructor [ ... ] # PPI::Statement::Compound # PPI::Structure::Block { ... } # PPI::Statement # PPI::Token::Symbol '%args' # # It should be like # # PPI::Structure::Constructor [ ... ] # PPI::Statement # PPI::Structure::Constructor { ... } # PPI::Statement::Expression # # which is what ppidump "[{x=>1}]" gives. # # The PPI::Structure::List is for something like # ppidump "func({ %args })" # which in for example PPI 1.220 was PPI::Structure::Block too. # That one is ok in PPI 1.270 (when ready to demand that version). # # The plan would be to remove the whole of this check for # PPI::Statement::Compound if PPI can do the right thing on arrayrefs # too ... return 1; } return 0; } # $elem is a PPI::Structure::Block # return true if it contains two or more PPI::Statement # sub _block_has_multiple_statements { my ($elem) = @_; my $count = 0; foreach my $child ($elem->schildren) { $count++; if ($count >= 2) { return 1; } } return 0; } # $elem is a PPI::Structure::Block # return true if it starts with a ";" # sub _block_starts_semi { my ($elem) = @_; # note child() not schild() since an initial ";" is not "significant" $elem = $elem->child(0); ### first child: $elem && (ref $elem)." $elem" $elem = _elem_skip_whitespace_and_comments($elem); return ($elem && $elem->isa('PPI::Statement::Null')); } # $elem is a PPI::Element or undef # return the next non-whitespace and non-comment after it sub _elem_skip_whitespace_and_comments { my ($elem) = @_; while ($elem && ($elem->isa('PPI::Token::Whitespace') || $elem->isa ('PPI::Token::Comment'))) { $elem = $elem->next_sibling; ### next elem: $elem && (ref $elem)." $elem" } return $elem; } sub _elem_is_semicolon { my ($elem) = @_; return ($elem->isa('PPI::Token::Structure') && $elem eq ';'); } # $elem is a PPI::Node # return true if any following sibling (not $elem itself) contains a newline sub _newline_in_following_sibling { my ($elem) = @_; while ($elem = $elem->next_sibling) { if ($elem =~ /\n/) { return 1; } } return 0; } # $block is a PPI::Structure::Block # return true if it's "do{}" expression, and not a "do{}while" or "do{}until" # loop sub _block_is_expression { my ($elem) = @_; ### _block_is_expression(): "$elem" if (my $next = $elem->snext_sibling) { if ($next->isa('PPI::Token::Word') && $postfix_loops{$next}) { ### {}while or {}until, not an expression return 0; } } ### do, map, grep, sort, etc are expressions .. my $prev = $elem->sprevious_sibling; return ($prev && $prev->isa('PPI::Token::Word') && $prefix_expressions{$prev}); } # Return true if $elem is a "try" block like # Try.pm try { } catch {} # TryCatch.pm try { } catch ($err) {} ... catch {} # Syntax::Feature::Try try { } catch ($err) {} ... catch {} finally {} # The return is true only for the block type "try"s of these three modules. # "try" forms from Try::Tiny and its friends are plain subroutine calls # rather than blocks. # sub _elem_is_try_block { my ($elem) = @_; return ($elem->isa('PPI::Statement') && ($elem = $elem->schild(0)) && $elem->isa('PPI::Token::Word') && $elem->content eq 'try' && _elem_has_preceding_use_trycatch($elem)); } # return true if $elem is preceded by any of # use Try # use TryCatch # use syntax 'try' sub _elem_has_preceding_use_trycatch { my ($elem) = @_; my $ret = 0; my $document = $elem->top; # PPI::Document, not Perl::Critic::Document $document->find_first (sub { my ($doc, $e) = @_; # ### comment: (ref $e)." ".$e->content if ($e == $elem) { ### not found before target elem, stop ... return undef; } if (_elem_is_use_try($e)) { ### found "use Try" etc, stop ... $ret = 1; return undef; } return 0; # continue }); return $ret; } sub _elem_is_use_try { my ($elem) = @_; ($elem->isa('PPI::Statement::Include') && $elem->type eq 'use') or return 0; my $module = $elem->module; return ($module eq 'Try' || $module eq 'TryCatch' || ($module eq 'syntax' && _syntax_has_feature($elem,'try'))); } # $elem is a PPI::Statement::Include of "use syntax". # Return true if $feature (a string) is among the feature names it imports. sub _syntax_has_feature { my ($elem, $feature) = @_; return ((grep {$_ eq $feature} _syntax_feature_list($elem)) > 0); } # $elem is a PPI::Statement::Include of "use syntax". # Return a list of the feature names it imports. sub _syntax_feature_list { my ($elem) = @_; ### _syntax_feature_list(): $elem && ref $elem my @ret; for ($elem = $elem->schild(2); $elem; $elem = $elem->snext_sibling) { if ($elem->isa('PPI::Token::Word')) { push @ret, $elem->content; } elsif ($elem->isa('PPI::Token::QuoteLike::Words')) { push @ret, $elem->literal; } elsif ($elem->isa('PPI::Token::Quote')) { push @ret, $elem->string; } } return @ret; } 1; __END__ =for stopwords boolean hashref eg Ryde =head1 NAME Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon - require a semicolon at the end of code blocks =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you to put a semicolon C<;> on the final statement of a subroutine or block. sub foo { do_something(); # ok } sub bar { do_something() # bad } The idea is that if you add more code you don't have to notice the previous line needs a terminator. It's also more like the C language, if you consider that a virtue. This is only a matter of style since the code runs the same either way, and on that basis this policy is low severity and under the "cosmetic" theme (see L). =head2 Same Line Closing Brace By default (see L below), a semicolon is not required when the closing brace is on the same line as the last statement. This is good for constants and one-liners. sub foo { 'my-constant-value' } # ok sub square { return $_[0] ** 2 } # ok =head2 Final Value Expression A semicolon is not required in places where the last statement is an expression giving a value. map { some_thing(); $_+123 # ok } @values; do { foo(); 1+2+3 # ok } This currently means do grep map sort # builtins reduce any all none notall first # List::Util pairfirst pairgrep pairmap mapp map_pairwise grepp grep_pairwise # List::Pairwise firstp first_pairwise lastp last_pairwise These module function names are always treated as expressions. There's no check for whether the respective module is actually in use. Fully qualified names like C are recognised too. C or C loops are ordinary blocks, not expression blocks, so still require a semicolon on the last statement inside. do { foo() # bad } until ($condition); =head2 Try/Catch Blocks The C, C and C modules all add C block forms. These are blocks not requiring a terminating semicolon, the same as an C etc doesn't. use TryCatch; sub foo { try { attempt_something(); } catch { error_recovery(); } # ok, no semi required here for TryCatch } The insides of the C and C are the same as other blocks, but the C statement itself doesn't require a semicolon. (See policy C to notice one added unnecessarily.) For reference, C doesn't know C/C specifically, so when they don't have a final semicolon the next statement runs together and the nature of those parts might be lost. This could upset things like recognition of C loops and could potentially make some perlcritic reports go wrong. The C/C block exemption here is only for the modules with this block syntax. There are other try modules such as C and friends where a final semicolon is normal and necessary if more code follows (because their C and C are ordinary function calls prototyped to take code blocks). use Try::Tiny; sub foo { try { attempt_something(); } catch { error_recovery(); } # bad, semi required here for Try::Tiny } =head2 Disabling If you don't care about this you can always disable from your F<.perlcriticrc> file in the usual way (see L), [-CodeLayout::RequireFinalSemicolon] =head1 CONFIGURATION =over 4 =item C (boolean, default true) If true (the default) then don't demand a semicolon if the closing brace is on the same line as the final statement. sub foo { return 123 } # ok if "except_same_line=yes" # bad if "except_same_line=no" =item C (boolean, default true) If true (the default) then don't demand a semicolon at the end of an expression block, as described under L above. # ok under "except_expression_blocks=yes" # bad under "except_expression_blocks=no" do { 1+2+3 } map { $_+1 } @array grep {defined} @x The statements and functions for this exception are currently hard coded. Maybe in the future they could be configurable, though multi-line expressions in this sort of thing tends to be unusual anyway. (See policy C for example to demand C is only one line.) =back =head1 BUGS It's very difficult to distinguish a code block from an anonymous hashref constructor if there might be a function prototype in force, eg. foo { abc => 123 }; # hash ref normally # code block if foo() has prototype C tends to assume code. C currently assumes hashref so as to avoid false violations. Any C, C or C are presumed to be code blocks (the various Try modules). Perhaps other common or particular functions or syntax with code blocks could be recognised. In general this sort of ambiguity is another good reason to avoid function prototypes. PPI as of its version 1.270 sometimes takes hashrefs in lists and arrarefs to be code blocks, eg. ppidump 'foo({%y,x=>1})' ppidump '[{%y,x=>1}]' ppidump '[{x=>1,%y}]' # ok, hash =head1 SEE ALSO L, L, L, L, L, L, L L, L, L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/CodeLayout/RequireTrailingCommaAtNewline.pm0000644000175000017500000002443714017115126026617 0ustar gggg# Copyright 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::CodeLayout::RequireTrailingCommaAtNewline; use 5.006; use strict; use warnings; use List::Util; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils qw(is_function_call is_method_call); use Perl::Critic::Pulp::Utils 'elem_is_comma_operator'; # uncomment this to run the ### lines #use Smart::Comments; our $VERSION = 100; use constant supported_parameters => ({ name => 'except_function_calls', description => 'Don\'t demand a trailing comma in function call argument lists.', behavior => 'boolean', default_string => '0', }); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; use constant default_themes => qw(pulp cosmetic); use constant applies_to => qw(PPI::Structure::List PPI::Structure::Constructor); sub violates { my ($self, $elem, $document) = @_; ### elem: ref($elem) ### content: "$elem" if ($self->{'_except_function_calls'}) { my $prev; if (($prev = $elem->sprevious_sibling) && $prev->isa('PPI::Token::Word') && (is_function_call($prev) || is_method_call($prev))) { ### is_function_call: !! is_function_call($prev) ### is_method_call: !! is_method_call($prev) return; } } my @children = $elem->children; @children = map {$_->isa('PPI::Statement') ? $_->children : $_} @children; ### children: "@children" if (_is_list_single_expression($elem)) { ### an expression not a list as such ... return; } my $newline = 0; my $after; foreach my $child (reverse @children) { if ($child->isa('PPI::Token::Whitespace') || $child->isa('PPI::Token::Comment')) { ### HWS ... $newline ||= ($child->content =~ /\n/); ### $newline $after = $child; } else { if ($newline && ! elem_is_comma_operator($child)) { return $self->violation ('Put a trailing comma at last of a list ending with a newline', '', $after); } last; } } return; } # $elem is any PPI::Element # Return true if it's a PPI::Structure::List which contains just a single # expression. Any "," or "=>" in the list is multiple expressions, but also # the various rules of the policy are applied as to what is list context # (array assignments, function calls). # sub _is_list_single_expression { my ($elem) = @_; $elem->isa('PPI::Structure::List') or return 0; my @children = $elem->schildren; { # eg. PPI::Structure::List # PPI::Statement::Expression # PPI::Token::Number '1' # PPI::Token::Operator ',' # so descend through PPI::Statement::Expression # @children = map { $_->isa('PPI::Statement::Expression') ? ($_->schildren) : ($_)} @children; if (List::Util::first {elem_is_comma_operator($_)} @children) { ### contains comma operator, so not an expression ... return 0; } } if (my $prev = $elem->sprevious_sibling) { if ($prev->isa('PPI::Token::Word')) { if ($prev eq 'return') { ### return statement without commas, is reckoned a single expression ... return 1; } if (is_function_call($prev) || is_method_call($prev)) { ### function or method call ... if ($children[-1] && $children[-1]->isa('PPI::Token::HereDoc')) { return 1; } return 0; } } elsif ($prev->isa('PPI::Token::Operator') && $prev eq '=' && _is_preceded_by_array($prev)) { ### array assignment, not a single expression ... if ($children[-1] && $children[-1]->isa('PPI::Token::HereDoc')) { return 1; } return 0; } } ### no commas, not a call, so is an expression return 1; } sub _is_preceded_by_array { my ($elem) = @_; ### _is_preceded_by_array: "$elem" my $prev = $elem->sprevious_sibling || return 0; while ($prev->isa('PPI::Structure::Subscript') || $prev->isa('PPI::Structure::Block')) { ### skip: ref $prev $prev = $prev->sprevious_sibling || return 0; } ### prev: ref $prev if ($prev->isa('PPI::Token::Symbol')) { my $cast; if (($cast = $prev->sprevious_sibling) && $cast->isa('PPI::Token::Cast')) { return ($cast->content eq '@'); } ### raw_type: $prev->raw_type return ($prev->raw_type eq '@'); } if ($prev->isa('PPI::Token::Cast')) { return ($prev->content eq '@'); } return 0; } 1; __END__ =for stopwords paren parens Parens hashref boolean Ryde runtime subr =head1 NAME Perl::Critic::Policy::CodeLayout::RequireTrailingCommaAtNewline - comma at end of list at newline =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you to put a comma at the end of a list etc when it ends with a newline, @array = ($one, $two # bad ); @array = ($one, $two, # ok ); This makes no difference to how the code runs, so the policy is low severity and under the "cosmetic" theme (see L). The idea is to make it easier when editing the code since you don't have to remember to add a comma to a preceding item when extending or re-arranging lines. If the closing bracket is on the same line as the last element then no comma is required. It can be be present if desired, but is not required. $hashref = { abc => 123, def => 456 }; # ok Parens around an expression are not a list, so nothing is demanded in for instance $foo = ( 1 + 2 # ok, an expression not a list ); But a single element paren expression is a list when it's in an array assignment or a function or method call. @foo = ( 1 + 2 # bad, list of one value ); @foo = ( 1 + 2, # ok ); =head2 Return Statement A C statement with a single value is considered an expression so a trailing comma is not required. return ($x + $y # ok ); Whether such code is a single-value expression or a list of only one value depends on how the function is specified. There's nothing in the text (nor even at runtime) which would say for sure. It's handy to included parens around a single-value expression to make it clear some big arithmetic is all part of the return, especially if you can't remember precedence levels. In such an expression a newline before the final ")" can help keep a comment together with a term for a cut and paste, or not lose a paren if commenting the last line, etc. So for now the policy is lenient. Would an option be good though? =head2 Here Documents An exception is made for a single expression ending with a here-document. This is slightly experimental, and might become an option, but the idea is that a newline is necessary for a here-document within parens and so shouldn't demand a comma. foo(<EEOF>) then trailing comma considerations don't apply. But both forms work and so are a matter of personal preference. foo(< in the usual way (see L), [-CodeLayout::RequireTrailingCommaAtNewline] =head1 CONFIGURATION =over 4 =item C (boolean, default false) If true then function calls and method calls are not checked, allowing for instance foo ( 1, 2 # ok under except_function_calls ); The idea is that if C takes only two arguments then you don't want to write a trailing comma as it might suggest something more could be added. Whether you write calls spread out this way is a matter of personal preference. If you do then enable C with the following in your F<.perlcriticrc> file, [CodeLayout::RequireTrailingCommaAtNewline] except_function_calls=1 =back =head1 SEE ALSO L, L, L =head2 Other Ways to Do It This policy is a variation of C. That policy doesn't apply to function calls or hashref constructors, and you may find its requirement for a trailing comma in even one-line lists like C<@x=(1,2,)> too much. =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/0002755000175000017500000000000015071066561022445 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitBarewordDoubleColon.pm0000644000175000017500000001515214017115130030363 0ustar gggg# Copyright 2010, 2011, 2012, 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 . package Perl::Critic::Policy::ValuesAndExpressions::ProhibitBarewordDoubleColon; use 5.006; use strict; use warnings; use List::Util; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp; use Perl::Critic::Pulp::Utils 'elem_is_comma_operator'; # uncomment this to run the ### lines #use Smart::Comments; our $VERSION = 100; use constant supported_parameters => ({ name => 'allow_indirect_syntax', description => 'Whether to allow double-colon in indirect object syntax "new Foo:: arg,arg".', behavior => 'boolean', default_string => '1', }); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOWEST; use constant default_themes => qw(pulp cosmetic); use constant applies_to => 'PPI::Token::Word'; sub violates { my ($self, $elem, $document) = @_; $elem =~ /::$/ or return; if ($self->{'_allow_indirect_syntax'}) { if (_word_is_indirect_call_classname($elem)) { return; } } return $self->violation ('Use plain string instead of Foo:: bareword', '', $elem); } # $elem is a PPI::Token::Word. # Return true if it's the class name in an indirect object syntax method call. # sub _word_is_indirect_call_classname { my ($elem) = @_; ### _word_is_indirect_call_classname(): "$elem" my $prev = $elem->sprevious_sibling || do { ### no method preceding, not an indirect call ... return 0; }; ### prev: ref $prev, $prev->content if (! $prev->isa('PPI::Token::Word')) { ### not a bareword method name preceding, not an indirect call ... return 0; } if ($prev eq 'return') { ### return is never an indirect call ... return 0; } # What about "foo bar Foo::"? Assume its function foo and method bar? # # $prev = $prev->sprevious_sibling; # ### prev-prev: ref $prev, $prev->content # if ($prev && $prev->isa('PPI::Token::Word')) { return 0; } if (my $next = $elem->snext_sibling) { if ($next->isa('PPI::Token::Operator') && $next eq '=>') { # "word1 word2 => ..." is either a function call to word1 or a syntax # error, not an indirect call. But "word1 word2," can be an indirect # call in a comma operator list # ### fat comma not an indirect ... return 0; } } return 1; } 1; __END__ =for stopwords barewords bareword disambiguates ie runtime boolean Ryde =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::ProhibitBarewordDoubleColon - don't use Foo:: style barewords =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you not to use the double-colon bareword like $class = Foo::Bar::; # bad but instead a plain string $class = 'Foo::Bar'; # ok This is intended as a building block for a restricted coding style, or a matter of personal preference if you think the C<::> is a bit obscure and that it's clearer to write a string when you mean a string. On that basis the policy is lowest severity and under the "cosmetic" theme (see L). =head2 Indirect Object Syntax By default a double-colon is allowed in the indirect object syntax (see L). my $obj = new Foo::Bar:: $arg1,$arg2; # ok This is because C<::> there is important to disambiguate a class name C from a function C, ie. function C in package C. Whether you actually want indirect object syntax is a matter for other policies, like L|Perl::Critic::Policy::Objects::ProhibitIndirectSyntax>. If you don't want the double-colon bareword then change to arrow style C<< Foo::Bar->new($arg,...) >>. =head2 Double-Colon Advantages The C<::> bareword is for use on package names, not general bareword quoting. If there's no such package at compile time a warning is given (see L) my $class = No::Such::Package::; # Perl warning This warning can help pick up typos, though it relies on relevant packages being loaded at compile-time (ie. C). If the package is loaded by a C at runtime then the warning fires even though the code runs correctly. For reference, a warning isn't given for the indirect object syntax, which rather limits its benefit. =head2 Disabling If you don't care about this you can always disable C from your F<.perlcriticrc> in the usual way (see L), [-ValuesAndExpressions::ProhibitBarewordDoubleColon] =head1 CONFIGURATION =over 4 =item C (boolean, default true) If true then allow double-colon in the indirect object syntax as shown above. If false then report double-colons everywhere as violations # bad under allow_indirect_syntax=false my $obj = new Foo::Bar:: $arg1,$arg2; This can be controlled from your F<~/.perlcriticrc> in the usual way. For example [ValuesAndExpressions::ProhibitBarewordDoubleColon] allow_indirect_syntax=no =back =head1 SEE ALSO L, L, L L can be used as implicitly quoted package name"> =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/NotWithCompare.pm0000644000175000017500000002434514017115130025676 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::ValuesAndExpressions::NotWithCompare; use 5.006; use strict; use warnings; use List::Util qw(min max); use base 'Perl::Critic::Policy'; # 1.100 for precedence_of() supporting -f etc filetests use Perl::Critic::Utils 1.100 qw(is_perl_builtin is_perl_builtin_with_no_arguments precedence_of); our $VERSION = 100; 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::Operator'; my %op_postfix = ('++' => 1, '--' => 1); my %op_andor = ('&&' => 1, '||' => 1, '//' => 1, 'and' => 1, 'or' => 1, 'xor' => 1); my %post_control = (if => 1, unless => 1, until => 1, for => 1, foreach => 1, while => 1); my %is_bad_precedence = (precedence_of('=~') => 1, precedence_of('>') => 1, precedence_of('==') => 1); my $stop_precedence = max (keys %is_bad_precedence); sub violates { my ($self, $bang_elem, $document) = @_; if ($bang_elem->content ne '!') { return; } my $constants; # only report when "!" is at the start of an expression, so "-f ! $x" is # not applicable (though bizarre), or with "! ! $x" look only from the # first "!" if (my $prev = $bang_elem->sprevious_sibling) { if ($prev->isa('PPI::Token::Operator')) { my $op = $prev->content; if (! $op_andor{$op}) { # but do look following "&&" etc return; } } } my $state = 'prefix'; my $seen_precedence = 1; my $elem = $bang_elem; for (;;) { $elem or return; # nothing evil up to end of expression $elem = $elem->snext_sibling or return; # nothing evil up to end of expression if ($elem->isa('PPI::Token::Cast')) { # "\ &foo" is a single form, not a function call $elem = _next_cast_operand ($elem); $state = 'postfix'; next; } if ($elem->isa('PPI::Token::Symbol')) { $state = 'postfix'; if ($elem->content =~ /^&/) { if (my $after = $elem->snext_sibling) { if ($after->isa('PPI::Structure::List')) { $elem = $after; # "! &foo() == 1" next; } } # "! &foo ..." varargs function call, eats to "," or ";" return; } next; # "! $x" etc } if ($elem->isa('PPI::Token::Operator')) { my $op = $elem->content; if ($state eq 'postfix' && $op_postfix{$op}) { next; # stay in postfix state after '++' or '--' } if ($state eq 'prefix' && $op eq '<') { # in prefix position assume "<" is "" glob or readline $elem = _next_gt ($elem); $state = 'postfix'; next; # can leave $elem undef for something dodgy like "! < 123" } my $precedence = precedence_of($op) || return; if ($precedence > $stop_precedence) { return; # something below "==" etc, expression to ! is ok } if (($op eq '==' || $op eq '!=') && _snext_is_bang($elem)) { return; # special case "! $x == ! $y" is ok } if ($op eq '->') { if (my $method = $elem->snext_sibling) { $elem = $method; $state = 'postfix'; if (my $after = $method->snext_sibling) { if ($after->isa('PPI::Token::Operator')) { next; # "! $foo->bar == 1" } if ($after->isa('PPI::Structure::List')) { $elem = $after; # "! $foo->bar() == 1" next; } # bogosity "$foo->bar 123, 456" or the like return; } } } if ($seen_precedence <= $precedence && $is_bad_precedence{$precedence}) { # $op is a compare, so bad return $self->violation ("Logical \"!\" attempted with a compare \"$op\"", '', $bang_elem); } $seen_precedence = max ($precedence, $seen_precedence); $state = 'prefix'; next; } if ($elem->isa('PPI::Token::Word')) { my $word = $elem->content; if ($post_control{$word}) { return; # postfix control like "$foo = ! $foo if ..." ends expression } if (is_perl_builtin_with_no_arguments ($word)) { # eg "! time ..." # "time" is a single token, look at operators past it $state = 'postfix'; next; } $constants ||= _constants ($document); if (exists $constants->{$word}) { # eg. use constant FOO => 456; # ! FOO ... # the FOO is a single token, look at operators past it $state = 'postfix'; next; } my $next = $elem->snext_sibling or return; # "! FOO" expression ending at a bareword if ($next->isa('PPI::Structure::List')) { # "! FOO(...)" function call $elem = next; $state = 'postfix'; next; } if (is_perl_builtin ($word)) { return; # builtins all taking args, eating "," or ";" } if ($next->isa('PPI::Token::Operator')) { my $op = $next->content; if ($op eq '<') { if (_next_gt ($next)) { # "! FOO <*.c>" assumed to be glob passed to varargs func, it # ends at "," or ";" so nothing bad for "!" return; } } # other "! FOO > 123" assumed to be a constant $state = 'postfix'; next; } # otherwise word is a no parens call, like "foo 123, 456" # exactly how this parses depends on the prototype, but there's # going to be a "," or ";" terminating, so our "!" is ok return; } } return; } sub _snext_is_bang { my ($elem) = @_; my $next = $elem->snext_sibling; return ($next && $next->isa('PPI::Token::Operator') && $next eq '!'); } # return the next ">" operator following $elem, or undef if no such sub _next_gt { my ($elem) = @_; while ($elem = $elem->snext_sibling) { if ($elem->isa('PPI::Token::Operator') && $elem eq '>') { last; } } return $elem; } # $elem is a PPI::Token::Cast, return its operand elem, meaning the next # non-Cast (usually a Symbol). Return undef if no non-cast, for something # dodgy like "\" with nothing following. sub _next_cast_operand { my ($elem) = @_; while ($elem = $elem->snext_sibling) { if (! $elem->isa('PPI::Token::Cast')) { last; } } return $elem; } # return a hashref which has keys for all the "use constant"s defined in # $document sub _constants { my ($document) = @_; return ($document->{__PACKAGE__.'.NotWithCompareConstants'} ||= do { require Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt; my %constants; $document->find (sub { my ($document, $elem) = @_; @constants{ Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt::_use_constants($elem) } = (); # hash slice return 0; # no-match, and continue }); \%constants; }); } 1; __END__ =for stopwords booleans varargs builtins args Ryde =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::NotWithCompare - logical not used with compare =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It picks up some cases of logical not C used with a comparison, like ! $x =~ /^[123]/ # bad ! $x + $y >= $z # bad In each case precedence means Perl parses this as C<< (!$x) >>, like (! $x) =~ /^[123]/ (! $x) + $y >= $z rather than a negated comparison. Usually this is a mistake, so this policy is under the "bugs" theme (see L). As a special case, C on both sides of C<< == >> or C<< != >> is allowed, since it's quite a good way to compare booleans. !$x == !$y # ok !$x != !$y # ok =head1 LIMITATIONS User functions called without parentheses are assumed to be usual varargs style. But a prototype may mean that's not the case, letting a bad C-with-compare expression to go undetected. ! userfunc $x == 123 # indeterminate # without prototype would be ok: ! (userfunc ($x==123)) # with ($) prototype would be bad: (! userfunc($x)) == 123 Perl builtins with no args, and constant subs created with C or C in the file under test are recognised. Hopefully anything else too weird is rare. ! time == 1 # bad use constant FIVE => 5; ! FIVE < 1 # bad sub name () { "foo" } ! name =~ /bar/ # bad =head1 SEE ALSO L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitFiletest_f.pm0000644000175000017500000001355214017115130026556 0ustar gggg# Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 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 . package Perl::Critic::Policy::ValuesAndExpressions::ProhibitFiletest_f; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp; our $VERSION = 100; 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::Operator'; sub violates { my ($self, $elem, $document) = @_; return if ($elem->content ne '-f'); return $self->violation ("Don't use the -f file test", '', $elem); } 1; __END__ =for stopwords seekable filename Ryde =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::ProhibitFiletest_f - don't use the -f file test =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you not to use the C<-f> file test because doing so is usually wrong or unnecessarily restrictive. On that basis this policy is under the "bugs" theme and medium severity, see L. =over 4 =item C<-f> is not the opposite of C<-d> If you're traversing a tree and want to distinguish files from directories to descend into, then C<-d> should be used so device files or named pipes can be processed. if (-f $filename) { # bad process ($filename); } else { descend ($filename); } if (-d $filename) { # better descend ($filename); } else { process ($filename); } =item C<-f> doesn't mean readable/writable/seekable Char specials and named pipes are perfectly good for reading and writing, and char specials can support seeking. Demanding C<-f> is an unnecessary restriction. You might only ever use ordinary files normally, but there's no need to prevent someone else running it on a tape drive, F, etc. You always have to test each C etc for success anyway, and that will tell you if a file is seekable. seek HANDLE, 123, 0 or die "Cannot seek: $!"; =item C<-e> is better than C<-f> A few inflexible functions or operations may not have good "file not found" behaviour and may force you to check for a file before invoking. Using C<-e> is better than C<-f> since as described above it doesn't unnecessarily disallow device files. if (-f $filename) { # bad require $filename; } if (-e $filename) { # better require $filename; } =item C<-f> before opening is a race condition Testing a filename before opening is bad. Any test before opening is useless because the file can change or be removed in between the test and the open (L, and L, note this about C<-r> etc too). if (-f $filename) { # bad open HANDLE, '<', $filename } If you want to know if the file can be opened then open the file! The error return from C must be checked, so a test beforehand only duplicates that, and is an opportunity to wrongly presume what the system or the user's permissions can or can't do. When opening, C will say if there was no such file, or C if it's in fact a directory. if (! open HANDLE, '<', $filename) { # better if ($! == POSIX::ENOENT()) { ... } } If you really do want to enquire into the nature of the file, in order to only accept ordinary files, then open first and C<-f> on the handle. But that's unusual except for an archiving or backup program. Incidentally, the error message in C<$!> is normally the best thing to print. It can be slightly technical, but its wording will at least be familiar from other programs and is translated into the user's locale language. =back =head2 Disabling Most uses of C<-f> tend to shell script style code written in Perl. In the shell, it's usually not possible to do better than such tests (though C<-d> or C<-e> are still generally better than C<-f>), but Perl can do the right thing. A blanket prohibition like this policy is harsh, but is meant as a building block or at least to make you think carefully whether C<-f> is really right. As always you can disable C from your F<.perlcriticrc> in the usual way (see L), [-ValuesAndExpressions::ProhibitFiletest_f] =head1 SEE ALSO L, L, L, L, L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitEmptyCommas.pm0000644000175000017500000001434414017115130026730 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyCommas; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp::Utils; # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; use constant default_themes => qw(pulp cosmetic); use constant applies_to => ('PPI::Token::Operator'); sub violates { my ($self, $elem, $document) = @_; $Perl::Critic::Pulp::Utils::COMMA{$elem} or return; my $prev = $elem->sprevious_sibling; if ($prev && ! ($prev->isa('PPI::Token::Operator') && $Perl::Critic::Pulp::Utils::COMMA{$prev})) { # have a previous element and it's not a comma operator return; } # A statement like # # return bless({@_}, $class) # # is parsed by PPI as # # PPI::Structure::List ( ... ) # PPI::Statement::Compound # PPI::Structure::Block { ... } # PPI::Statement # PPI::Token::Magic '@_' # PPI::Statement::Expression # PPI::Token::Operator ',' # PPI::Token::Symbol '$class' # # so the "{@_}" bit is not an immediate predecessor of the "," operator. # If our $elem has no $prev then also look outwards to see if it's at the # start of an expression which is in a list and there's something # preceding in the list. # if (! $prev) { my $parent = $elem->parent; if ($parent->isa('PPI::Statement::Expression') && $parent->parent->isa('PPI::Structure::List') && $parent->sprevious_sibling) { return; } } # An expression like # # [{%a},{}] # # is parsed by PPI 1.215 as # # PPI::Statement # PPI::Structure::Constructor [ ... ] # PPI::Statement::Compound # PPI::Structure::Block { ... } # PPI::Statement # PPI::Token::Symbol '%a' # PPI::Statement # PPI::Token::Operator ',' # PPI::Structure::Constructor { ... } # # so the "{%a}" bit is not an immediate predecessor of the "," operator. # If our $elem has no $prev then also look upwards to see if it's at the # start of an statement which is in a constructor and there's something # preceding in that constructor. # if (! $prev) { my $parent = $elem->parent; ### parent: ref $parent if ($parent->isa('PPI::Statement') && $parent->parent->isa('PPI::Structure::Constructor') && $parent->sprevious_sibling) { return; } } # $prev is either nothing or a comma operator return $self->violation ('Empty comma operator', '', $elem); } 1; __END__ =for stopwords Ryde =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::ProhibitEmptyCommas - disallow empty consecutive commas =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It prohibits empty comma operators C<,> or C<=E> meaning either consecutive commas or a comma at the start of a list or expression. print 'foo',,'bar'; # bad @a = (,1,2); # bad foo (x, => 123); # bad a =>=> 456; # bad for (; $i++<10; $i++,,) # bad func (,) # bad Extra commas like this are harmless and simply collapse out when the program runs (see L), so this policy is only under the "cosmetic" theme (see L). Usually this sort of thing is just a stray, or leftover from cut and paste, or perhaps some over-enthusiastic column layout. Occasionally it can be something more dubious, # did you mean 1..6 range operator? @a = (1,,6); # bad # this is two args, did you want three? foo (1, , 2); # bad # this is three args, probably you forgot a value bar (abc => , # bad def => 20); A comma at the end of a list or call is allowed. That's quite usual and can be a good thing when cutting and pasting lines (see C to mandate them!). @b = ("foo", "bar", # ok ); If you use multiple commas in some systematic way for code layout you can always disable C from your F<.perlcriticrc> file in the usual way (see L), [-ValuesAndExpressions::ProhibitEmptyCommas] =head1 SEE ALSO L, L, L, L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitArrayAssignAref.pm0000644000175000017500000001265614017115130027517 0ustar gggg# Copyright 2011, 2012, 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 . # eg. # perlcritic -s ProhibitArrayAssignAref /usr/lib/perl5/Template/Test.pm package Perl::Critic::Policy::ValuesAndExpressions::ProhibitArrayAssignAref; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp; # uncomment this to run the ### lines #use Smart::Comments; our $VERSION = 100; 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', 'PPI::Token::Cast'); sub violates { my ($self, $elem, $document) = @_; ($elem->isa('PPI::Token::Cast') ? $elem->content : $elem->raw_type) eq '@' or return; ### ProhibitArrayAssignAref: $elem->content my $thing = 'Array'; for (;;) { $elem = $elem->snext_sibling || return; last if $elem->isa('PPI::Token::Operator'); ### skip: ref $elem # @foo[1,2] gives the [1,2] as a PPI::Structure::Subscript # @{foo()}[1,2] gives the [1,2] as a PPI::Structure::Constructor # the latter is probably wrong (as of PPI 1.215) if ($elem->isa('PPI::Structure::Subscript') || $elem->isa('PPI::Structure::Constructor')) { if ($elem->start eq '[') { $thing = 'Array slice'; } elsif ($elem->start eq '{') { $thing = 'Hash slice'; } } } ### $thing ### operator: $elem->content $elem eq '=' or return; $elem = $elem->snext_sibling || return; ($elem->isa('PPI::Structure::Constructor') && $elem->start eq '[') or return; return $self->violation ("$thing assigned a [] arrayref, should it be a () list ?", '', $elem); } 1; __END__ =for stopwords Ryde arrayref parens Derefs Dereferences =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::ProhibitArrayAssignAref - don't assign an anonymous arrayref to an array =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. 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 L) for the chance C<[]> 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 L) 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 =head2 List Assignment Parens This policy is not a blanket requirement for C<()> parens on array assignments. It's normal and unambiguous to have a function call or C 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 C<,> comma operator has lower precedence than C<=> (see L), 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 C form gives a list too @array = qw(a b c); # ok =head1 SEE ALSO L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/ConstantBeforeLt.pm0000644000175000017500000002235014017115130026201 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 # . package Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt; use 5.006; use strict; use warnings; use PPI 1.220; # for its incompatible change to PPI::Statement::Sub->prototype use base 'Perl::Critic::Policy'; use Perl::Critic::Utils qw(is_included_module_name is_method_call is_perl_builtin_with_no_arguments split_nodes_on_comma); # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; # # Incidentally "require Foo < 123" is a similar sort of problem in all Perls # (or at least up to 5.10.0) with "<" being taken to be a "< >". But since # it always provokes a warning when run it doesn't really need perlcritic, # or if it does then leave it to another policy to address. # 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::Document'); sub violates { my ($self, $document) = @_; my @violations; my %constants; my $constants = \%constants; $document->find (sub { my ($document, $elem) = @_; @constants{ _use_constants($elem) } = 1; # hash slice push @violations, _one_violate ($self, $elem, $constants); return 0; # no-match, and continue }); return @violations; } sub _one_violate { my ($self, $elem, $constants) = @_; if (! $elem->isa ('PPI::Token::Word')) { return; } # eg. "use constant FOO => 123; if (FOO < 456) {}" is ok, for a constant # defined at the point in question if (exists $constants->{$elem->content}) { return; } # eg "time < 123" is ok if (is_perl_builtin_with_no_arguments ($elem)) { return; } # eg. "bar" in "$foo->bar < 123" is ok if (is_method_call ($elem)) { return; } # eg. "Foo" in "require Foo" is not a constant if (is_included_module_name ($elem)) { return; } # must be followed by "<" like "MYBAREWORD < 123" my $lt = $elem->snext_sibling or return; $lt->isa('PPI::Token::Operator') or return; $lt->content eq '<' or return; # if a ">" somewhere later like "foo <...>" then it's probably a function # call on a readline or glob # my $after = $lt; for (;;) { $after = $after->snext_sibling or last; if ($after->content eq '>') { return; } } return $self->violation ('Bareword constant before "<"', '', $elem); } # $elem is any element. If it's a "use constants" or a "sub foo () { ...}" # then return the name or names of the constants so created. Otherwise # return an empty list. # # Perl::Critic::StricterSubs::Utils::find_declared_constant_names() does # some similar stuff, but it crunches the whole document at once, instead of # just one statement. # my %constant_modules = ('constant' => 1, 'constant::defer' => 1); sub _use_constants { my ($elem) = @_; if ($elem->isa ('PPI::Statement::Sub')) { my $prototype = $elem->prototype; ### $prototype if (defined $prototype && $prototype eq '') { # prototype () if (my $name = $elem->name) { return $name; } } # anonymous sub or without prototype return; } return unless ($elem->isa ('PPI::Statement::Include') && $elem->type eq 'use' && $constant_modules{$elem->module || ''}); $elem = $elem->schild(2) or return; # could be "use constant" alone ### start at: $elem->content my $single = 1; if ($elem->isa ('PPI::Structure::Constructor')) { # multi-constant "use constant { FOO => 1, BAR => 2 }" # # PPI::Structure::Constructor { ... } # PPI::Statement # PPI::Token::Word 'foo' # $single = 0; # multiple constants $elem = $elem->schild(0) or return; # empty on "use constant {}" goto SKIPSTATEMENT; } elsif ($elem->isa ('PPI::Structure::List')) { # single constant in parens "use constant (FOO => 1,2,3)" # # PPI::Structure::List ( ... ) # PPI::Statement::Expression # PPI::Token::Word 'Foo' # $elem = $elem->schild(0) or return; # empty on "use constant {}" SKIPSTATEMENT: if ($elem->isa ('PPI::Statement')) { $elem = $elem->schild(0) or return; } } # split_nodes_on_comma() handles oddities like "use constant qw(FOO 1)" # my @nodes = _elem_and_ssiblings ($elem); my @arefs = split_nodes_on_comma (@nodes); ### @arefs if ($single) { $#arefs = 0; # first elem only } my @constants; for (my $i = 0; $i < @arefs; $i += 2) { my $aref = $arefs[$i]; if (@$aref == 1) { my $name_elem = $aref->[0]; if (! $name_elem->isa ('PPI::Token::Structure')) { # not final ";" push @constants, ($name_elem->can('string') ? $name_elem->string : $name_elem->content); next; } } ### ConstantBeforeLt skip non-name constant: $aref } return @constants; } sub _elem_and_ssiblings { my ($elem) = @_; my @ret; while ($elem) { push @ret, $elem; $elem = $elem->snext_sibling; } return @ret; } 1; __END__ =for stopwords bareword autoloaded unprototyped readline parens ConstantBeforeLt POSIX Bareword filehandle mis-ordering Ryde emphasises prototyped =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt - disallow bareword before < =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It prohibits a bareword before a C> to keep you out of trouble with autoloaded or unprototyped constant subs since a C> in that case is interpreted as the start of a C..E> glob or readline instead of a less-than. This policy is under the "bugs" theme (see L). use POSIX; DBL_MANT_DIG < 32 # bad, perl 5.8 thinks <> func <*.c> # ok, actual glob time < 2e9 # ok, builtins parse ok use constant FOO => 16; FOO < 32 # ok, your own const sub BAR () { 64 } BAR < 32 # ok, your own prototyped sub The fix for something like C 10> is parens either around or after, like (DBL_MANT_DIG) < 10 # ok DBL_MANT_DIG() < 10 # ok whichever you think is less worse. The latter emphasises it's really a sub. The key is whether the constant sub in question is defined and has a prototype at the time the code is compiled. ConstantBeforeLt makes the pessimistic assumption that anything except C and prototyped subs in your own file shouldn't be relied on. In practice the most likely problems are with the C module constants of Perl 5.8.x and earlier, since they were unprototyped. The default code generated by C (as of Perl 5.10.0) is similar autoloaded unprototyped constants so modules using the bare output of that suffer too. If you're confident the modules you use don't play tricks with their constants (including only using POSIX on Perl 5.10.0 or higher) then you might find ConstantBeforeLt too pessimistic. It normally triggers rather rarely anyway, but you can always disable it altogether in your F<.perlcriticrc> file (see L), [-ValuesAndExpressions::ConstantBeforeLt] =head1 OTHER NOTES Bareword file handles might be misinterpreted by this policy as constants, but in practice "<" doesn't get used with anything taking a bare filehandle. A constant used before it's defined, like if (FOO < 123) { ... } # bad ... use constant FOO => 456; is reported by ConstantBeforeLt since it might be an imported constant sub, even if it's much more likely to be a simple mis-ordering, which C picks up anyway when it runs. =head1 SEE ALSO L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitDuplicateHashKeys.pm0000644000175000017500000002430214017115130030037 0ustar gggg# Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020, 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 . package Perl::Critic::Policy::ValuesAndExpressions::ProhibitDuplicateHashKeys; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon; use Perl::Critic::Policy::Miscellanea::TextDomainPlaceholders; use Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt; use Perl::Critic::Pulp::Utils 'elem_is_comma_operator'; # uncomment this to run the ### lines #use Smart::Comments; our $VERSION = 100; 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::Structure::Constructor', 'PPI::Structure::List', # this policy is not for blocks, but PPI # mis-reports some anonymous hashref # constructors as blocks, so look at them 'PPI::Structure::Block'); sub violates { my ($self, $elem, $document) = @_; ### ProhibitDuplicateHashKeys violates() ... ### consider: (ref $elem)." $elem" if ($elem->isa('PPI::Structure::Constructor')) { ### constructor ... unless ($elem->start eq '{') { ### constructor is not a hash ... return; } } elsif ($elem->isa('PPI::Structure::Block')) { ### block ... if (Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon::_block_is_hash_constructor($elem) == 1) { ### block is a hash, continue ... } else { ### block is a block, or not certain, stop ... return; } } else { # PPI::Structure::List _elem_is_assigned_to_hash($elem) || return; } $elem = $elem->schild(0) || return; if ($elem->isa('PPI::Statement')) { $elem = $elem->schild(0) || return; } ### first elem: (ref $elem)." $elem" my @elems = Perl::Critic::Policy::ValuesAndExpressions::ConstantBeforeLt::_elem_and_ssiblings($elem); ### elems len: scalar(@elems) @elems = map {_expand_qw($_)} @elems; ### expanded len: scalar(@elems) my $state = 'key'; my @violations; my %seen_key; while (@elems) { ### $state my ($comma, @arg) = _take_to_comma(\@elems); if (! @arg) { ### consecutive commas ... next; } $elem = $arg[0]; ### first of arg: (ref $elem)." $elem" ### arg elem count: scalar(@arg) if ($elem->isa('PPI::Token::Cast') && $elem eq '%') { ### skip cast % even num elements ... $state = 'key'; next; } # %$foo is an even number of things if (@arg == 1 && $elem->isa('PPI::Token::Symbol') && $elem->raw_type eq '%') { ### skip hash var even num elements ... $state = 'key'; next; } if ($state eq 'unknown' && $comma eq '=>') { $state = 'key'; } if ($state eq 'key') { my $str; my $any_vars; if ($elem->isa('Perl::Critic::Pulp::ProhibitDuplicateHashKeys::Qword')) { ### qword ... $str = $elem->{'word'}; $any_vars = 0; $elem = $elem->{'elem'}; } else { ($str, $any_vars) = Perl::Critic::Policy::Miscellanea::TextDomainPlaceholders::_arg_string(\@arg, $document); } ### $str if (defined $str && ! $any_vars && $seen_key{$str}++) { ### found duplicate ... push @violations, $self->violation ("Duplicate hash key \"$str\"", '', $elem); } if ($any_vars >= 2) { ### expression, go to unknown ... $state = 'unknown'; } else { $state = 'value'; } } elsif ($state eq 'value') { if ($comma eq '=>') { ### hmm, something like a=>b=>..., assume next is a value still ... $state = 'value'; } else { $state = 'key'; } } } ### done ... return @violations; } sub _expand_qw { my ($elem) = @_; if (! $elem->isa('PPI::Token::QuoteLike::Words')) { return $elem; } my @words = $elem->literal; ### @words return map { Perl::Critic::Pulp::ProhibitDuplicateHashKeys::Qword->new (word => $_, elem => $elem); } @words; } sub _take_to_comma { my ($aref) = @_; my @ret; while (@$aref) { my $elem = shift @$aref; if ($elem->isa('Perl::Critic::Pulp::ProhibitDuplicateHashKeys::Qword')) { push @ret, $elem; return ',', @ret; } if (elem_is_comma_operator($elem)) { return $elem, @ret; # found a comma } push @ret, $elem; # not a comma } return '', @ret; # no final comma } # $elem is any PPI::Element # return true if it's assigned to a hash, # %foo = ELEM # %$foo = ELEM # %{expr()} = ELEM # sub _elem_is_assigned_to_hash { my ($elem) = @_; ### _elem_is_assigned_to_hash() ... $elem = $elem->sprevious_sibling || return 0; ($elem->isa('PPI::Token::Operator') && $elem eq '=') or return 0; $elem = $elem->sprevious_sibling || return 0; ### assign to: "$elem" # %{expr} = () deref if ($elem->isa('PPI::Structure::Block')) { $elem = $elem->sprevious_sibling || return 0; ### cast hash ... return ($elem->isa('PPI::Token::Cast') && $elem eq '%'); } if ($elem->isa('PPI::Token::Symbol')) { if ($elem->symbol_type eq '%') { ### yes, %foo ... return 1; } if ($elem->symbol_type eq '$') { ### symbol scalar ... # %$x=() or %$$$x=() deref for (;;) { $elem = $elem->sprevious_sibling || return 0; ### prev: (ref $elem)." $elem" if ($elem->isa('PPI::Token::Magic')) { # PPI 1.215 mistakes %$$$r as magic variable $$ } elsif ($elem->isa('PPI::Token::Cast')) { if ($elem ne '$') { ### cast hash: ($elem eq '%') return ($elem eq '%'); } } else { return 0; } } } } ### no ... return 0; } { package Perl::Critic::Pulp::ProhibitDuplicateHashKeys::Qword; sub new { my ($class, %self) = @_; return bless \%self, $class; } } 1; __END__ =for stopwords Ryde hashref runtime =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::ProhibitDuplicateHashKeys - disallow duplicate literal hash keys =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It reports duplicate literal hash keys in a hash assignment or anonymous hashref. my %hash = (red => 1, green => 2, red => 3, # bad ); my $hashref = { red => 1, red => 3, # bad }; Writing duplicate literal keys is probably a mistake or too much cut and paste, and if the values are different will make it unclear to human readers what was meant. On that basis this policy is under the "bugs" theme and medium severity (see L). Perl is happy to run code like the above. The value of the last "red" is stored. As runtime behaviour, this is good since you can give defaults which further values from a caller or similar can replace. For example, sub new { my $class = shift; return bless { foo => 'default', bar => 'default', @_ }, $class; } MyClass->new (foo => 'caller value'); # overriding 'default' =head2 Expressions Expressions within a hash list cannot be checked in general. Some concatenations of literals are recognised though they're probably unusual. my %hash = (ab => 1, 'a'.'b' => 2); # bad my %hash = (__PACKAGE__.'a' => 1, __PACKAGE__.'a' => 2); # bad Function calls etc within a list might return an odd or even number of values. Fat commas C<=E> are taken as indicating a key when in doubt. my %hash = (blah() => 1, # guided by => a => 2, a => 3); # bad my %hash = (blah(), a => 2, # guided by => a => 3); # bad A hash substitution is always an even number of arguments, my %hash = (a => 1, %blah, # even number a => 5); # bad, duplicate C words are recognised too my %hash = (qw(foo value1 foo value2)); # bad =head2 Disabling If you don't care about this you can always disable C from your F<.perlcriticrc> file in the usual way (see L), [-ValuesAndExpressions::ProhibitDuplicateHashKeys] =head1 SEE ALSO L, L L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitNullStatements.pm0000644000175000017500000002334714017115130027457 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 . package Perl::Critic::Policy::ValuesAndExpressions::ProhibitNullStatements; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon; # for try helpers our $VERSION = 100; use constant supported_parameters => ({ name => 'allow_perl4_semihash', description => 'Whether to allow Perl 4 style ";#" comments.', behavior => 'boolean', default_string => '0', }); use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM; use constant default_themes => qw(pulp cosmetic); use constant applies_to => ('PPI::Statement::Null', 'PPI::Token::Structure'); sub violates { my ($self, $elem, $document) = @_; if ($elem->isa('PPI::Statement::Null')) { # if allow_perl4_semihash then ";# comment ..." ok if ($self->{'_allow_perl4_semihash'} && _is_perl4_semihash($elem)) { return; # ok } # "for (;;)" is ok, like # # PPI::Structure::ForLoop ( ... ) # PPI::Statement::Null # PPI::Token::Structure ';' # PPI::Statement::Null # PPI::Token::Structure ';' # # or the incompatible change in ppi 1.205 # # PPI::Token::Word 'for' # PPI::Structure::For ( ... ) # PPI::Statement::Null # PPI::Token::Structure ';' # PPI::Statement::Null # PPI::Token::Structure ';' my $parent = $elem->parent; if ($parent->isa('PPI::Structure::For') || $parent->isa('PPI::Structure::ForLoop')) { return; # ok } # "map {; ...}" or "grep {; ...}" ok if (_is_block_disambiguator ($elem)) { return; # ok } } else { # PPI::Token::Structure ... if (! _is_end_of_try_block($elem)) { # not a semi at the end of a try {} catch {}; block, ok return; } } # any other PPI::Statement::Null is a bare ";" and is not ok, like # # PPI::Statement::Null # PPI::Token::Structure ';' # return $self->violation ('Null statement (stray semicolon)', '', $elem); } my %is_try_catch_keyword = (try => 1, catch => 1, finally => 1); # $elem is a PPI::Token::Structure # Return true if it's a semicolon ; at the end of a try/catch block for any # Try.pm, TryCatch.pm or Syntax::Feature::Try. Such a ; is unnecessary. sub _is_end_of_try_block { my ($elem) = @_; ($elem->content eq ';' && Perl::Critic::Policy::CodeLayout::RequireFinalSemicolon::_elem_is_try_block($elem->parent)) || return 0; # ppidump "try {} foo(123);" gives # PPI::Statement # PPI::Token::Word 'try' # PPI::Structure::Block { ... } # PPI::Token::Word 'foo' # PPI::Structure::List ( ... ) # PPI::Statement::Expression # PPI::Token::Number '123' # PPI::Token::Structure ';' for (;;) { $elem = $elem->sprevious_sibling || return 1; $elem->isa('PPI::Structure::Block') || return 0; $elem = $elem->sprevious_sibling || return 0; ($elem->isa('PPI::Token::Word') && $is_try_catch_keyword{$elem->content}) || return 0; } } # _is_block_disambiguator($elem) takes a PPI::Statement::Null $elem and # returns true if it's at the start of a "map {; ...}" or "grep {; ...}" # # PPI structure like the following, with the Whitespace optional of course, # and allow comments in there too in case someone wants to write "# force # block" or something # # PPI::Token::Word 'map' # PPI::Token::Whitespace ' ' # PPI::Structure::Block { ... } # PPI::Token::Whitespace ' ' # PPI::Statement::Null # PPI::Token::Structure ';' # sub _is_block_disambiguator { my ($elem) = @_; my $block = $elem->parent; $block ->isa('PPI::Structure::Block') or return 0; # not in a block # not "sprevious" here, don't want to skip other null statements, just # whitespace and comments my $prev = $elem->previous_sibling; while ($prev && ($prev->isa ('PPI::Token::Whitespace') || $prev->isa ('PPI::Token::Comment'))) { $prev = $prev->previous_sibling; } if ($prev) { return 0; # not at the start of the block } my $word = $block->sprevious_sibling or return 0; # nothing preceding the block $word->isa('PPI::Token::Word') or return 0; my $content = $word->content; return ($content eq 'map' || $content eq 'grep'); } # _is_perl4_semihash($elem) takes a PPI::Statement::Null $elem and returns # true if it's a Perl 4 style start-of-line ";# comment ..." # # When at the very start of a document, # # PPI::Document # PPI::Statement::Null # PPI::Token::Structure ';' # PPI::Token::Comment '# foo' # # When in the middle, # # PPI::Token::Whitespace '\n' # PPI::Statement::Null # PPI::Token::Structure ';' # PPI::Token::Comment '# hello' # sub _is_perl4_semihash { my ($elem) = @_; # must be at the start of the line # though not sure about this, the pl2pm program allows whitespace before ($elem->location->[1] == 1) or return 0; # must be immediately followed by a comment my $next = $elem->next_sibling; return ($next && $next->isa('PPI::Token::Comment')); } 1; __END__ =for stopwords ie ok boolean Ryde =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::ProhibitNullStatements - disallow empty statements (stray semicolons) =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It prohibits empty statements, ie. bare C<;> semicolons. This can be a typo doubling up a semi like use Foo;; # bad Or a stray left at the end of a control structure like if ($foo) { print "foo\n"; return; }; # bad An empty statement is harmless, so this policy is under the "cosmetic" theme (see L) and medium severity. It's surprisingly easy to leave a semi behind when chopping code around, especially when changing a statement to a loop or conditional. =head2 Allowed forms A C style C loop is ok. Those semicolons are expression separators and empties there are quite usual. for (;;) { # ok print "infinite loop\n"; } A semicolon at the start of a C or C block is allowed. It's commonly used to ensure Perl parses it as a block, not an anonymous hash. (Perl decides at the point it parses the C<{>. A C<;> there forces a block when it might otherwise guess wrongly. See L for more on this.) map {; $_, 123} @some_list; # ok grep {# this is a block ; # ok length $_ and $something } @some_list; The C form is much more common than the C, but both suffer the same ambiguity. C doesn't normally inspire people to quite such convoluted forms as C does. =head2 Try/Catch Blocks The C, C and C modules all add new C block statement forms. These statements don't require a terminating semicolon (the same as an C doesn't require one). Any semicolon there is reckoned as a null statement. use TryCatch; sub foo { try { attempt_something() } catch { error_recovery() }; # bad } This doesn't apply to other try modules such as C and friends. They're implemented as ordinary function calls (with prototypes), so a terminating semicolon is normal for them. use Try::Tiny; sub foo { try { attempt_something() } catch { error_recovery() }; # ok } =head1 CONFIGURATION =over 4 =item C (boolean, default false) If true then Perl 4 style documentation comments like the following are allowed. ;# Usage: ;# require 'mypkg.pl'; ;# ... The C<;> must be at the start of the line. This is fairly outdated, so it's disabled by default. If you're crunching through some old code you can enable it by adding to your F<.perlcriticrc> file [ValuesAndExpressions::ProhibitNullStatements] allow_perl4_semihash=1 =back =head1 SEE ALSO L, L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/UnexpandedSpecialLiteral.pm0000644000175000017500000002111414017115127027701 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 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 . # Change "12 Jul 2013 23:37:26 -0700" making __PACKAGE__ etc quoted by => # across newline. # # http://perl5.git.perl.org/perl.git/commit/21791330af556dc082f3ef837d772ba9a4d0b197 # http://perl5.git.perl.org/perl.git/patch/21791330af556dc082f3ef837d772ba9a4d0b197 package Perl::Critic::Policy::ValuesAndExpressions::UnexpandedSpecialLiteral; use 5.006; use strict; use warnings; use List::Util qw(min max); use base 'Perl::Critic::Policy'; use Perl::Critic::Utils qw(is_perl_builtin is_perl_builtin_with_no_arguments precedence_of); our $VERSION = 100; 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'); my %specials = ('__FILE__' => 1, '__LINE__' => 1, '__PACKAGE__' => 1); sub violates { my ($self, $elem, $document) = @_; $specials{$elem} or return; if (elem_is_quoted_by_big_comma ($elem)) { return $self->violation ("$elem is the literal string '$elem' on the left of a =>", '', $elem); } if (elem_is_solo_subscript ($elem)) { return $self->violation ("$elem is the literal string '$elem' in a hash subscript", '', $elem); } return; } # Perl::Critic::Utils::is_hash_key() does a similar thing to the following # tests, identifying something on the left of "=>", or in a "{}" subscript. # But here want those two cases separately since the subscript is only a # violation if $elem also has no siblings. (Separate cases allow a custom # error message too.) # # { __FILE__ => 123 } # ( __FILE__ => 123 ) # sub elem_is_quoted_by_big_comma { my ($elem) = @_; my $next = $elem; for (;;) { $next = $next->next_sibling || return 0; # nothing following if ($next->isa('PPI::Token::Whitespace') && $next->content !~ /\n/) { next; } return ($next->isa('PPI::Token::Operator') && $next->content eq '=>'); } } # $hash{__FILE__} # # PPI::Structure::Subscript { ... } # PPI::Statement::Expression # PPI::Token::Word '__PACKAGE__' # # and not multi subscript like $hash{__FILE__,123} # # PPI::Structure::Subscript { ... } # PPI::Statement::Expression # PPI::Token::Word '__PACKAGE__' # PPI::Token::Operator ',' # PPI::Token::Number '123' # sub elem_is_solo_subscript { my ($elem) = @_; # must be sole elem if ($elem->snext_sibling) { return 0; } if ($elem->sprevious_sibling) { return 0; } my $parent = $elem->parent || return 0; $parent->isa('PPI::Statement::Expression') || return 0; my $grandparent = $parent->parent || return 0; return $grandparent->isa('PPI::Structure::Subscript'); } 1; __END__ =for stopwords filename parens Subhash Concated HashRef OOP Ryde bareword Unexpanded =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::UnexpandedSpecialLiteral - specials like __PACKAGE__ used literally =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It picks up some cases where the special literals C<__FILE__>, C<__LINE__> and C<__PACKAGE__> (see L) are used with C<< => >> or as a hash subscript and so don't expand to the respective filename, line number or package name. my $seen = { __FILE__ => 1 }; # bad return ('At:'.__LINE__ => 123); # bad $obj->{__PACKAGE__}->{myextra} = 123; # bad In each case you get a string C<"__FILE__">, C<"__LINE__"> or C<"__PACKAGE__">, as if my $seen = { '__FILE__' => 1 }; return ('At:__LINE__' => 123); $obj->{'__PACKAGE__'}->{'myextra'} = 123; where almost certainly it was meant to expand to the filename etc. On that basis this policy is under the "bugs" theme (see L). Expression forms like 'MyExtra::'.__PACKAGE__ => 123 # bad are still bad because the word immediately to the left of a C<< => >> is quoted even when that word is part of an expression. If you really do want a string C<"__FILE__"> etc then the suggestion is to write the quotes, even if you're not in the habit of using quotes in hash constructors etc. It'll pass this policy and make it clear to everyone that you really did want the literal string. The C<__PACKAGE__> literal is new in Perl 5.004 but this policy is applied to all code. Even if you're targeting an earlier Perl extra quotes will make it clear to users of later Perl that a literal string C<"__PACKAGE__"> is indeed intended. =head2 Fat Comma After Newline A C<< => >> fat comma only quotes when it's on the same line as the preceding bareword, so in the following C<__PACKAGE__> is not quoted and is therefore not reported by this policy, my %hash = (__PACKAGE__ # ok, expands => 'blah'); Of course whether or not writing this is a good idea is another matter. It might be a bit subtle to depend on the newline. Probably a plain C<,> comma would make the intention clearer than C<< => >>. =head2 Class Data A bad C<< $obj->{__PACKAGE__} >> can arise when you're trying to hang extra data on an object using your package name to hopefully not clash with the object's native fields. Unexpanded C<__PACKAGE__> like that is a mistake you'll probably only make once; after that the irritation of writing extra parens or similar will keep it fresh in your mind! As usual there's more than one way to do it when associating extra data to an object. As a crib here are some ways, =over 4 =item Subhash C<< $obj->{(__PACKAGE__)}->{myfield} >> The extra parens ensure expansion, and you get a sub-hash (or sub-array or whatever) to yourself. It's easy to delete the single entry from C<$obj> if/when you later want to cleanup. =item Subscript C<< $obj->{__PACKAGE__,'myfield'} >> This makes entries in C<$obj>, with the C<$;> separator emulating multidimensional arrays/hashes (see L). =item Concated key C<< $obj->{__PACKAGE__.'--myfield'} >> Again entries in C<$obj>, but key formed by concatenation and an explicit unlikely separator. The advantage over C<,> is that the key is a constant (after constant folding), instead of a C on every access because C<$;> could change. =item Separate C Use the object as a hash key and the value whatever data you want to associate. Keeps completely out of the object's hair and also works with objects which use a "restricted hash" (see L) to prevent extra keys. =item Inside-Out C Similar to HashRef with object as key and any value you want as the data outside the object, hence the jargon "inside out". The docs are very hard to follow (as of its version 1.04), especially if you're not into OOP, but it's actually fairly simple. =item C Key/value pairs attached to an object using its "magic" list. Doesn't touch the object's contents but separate footnote users must be careful not to let their keys clash. =back =head1 SEE ALSO L, L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/ProhibitUnknownBackslash.pm0000644000175000017500000006236215071066373027767 0ustar gggg# Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021, 2025 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::ValuesAndExpressions::ProhibitUnknownBackslash; use 5.006; use strict; use version (); # but don't import qv() use warnings; # 1.084 for Perl::Critic::Document highest_explicit_perl_version() use Perl::Critic::Policy 1.084; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; use Perl::Critic::Pulp; # uncomment this to run the ### lines # use Smart::Comments; our $VERSION = 100; use constant supported_parameters => ({ name => 'single', description => 'Checking of single-quote strings.', behavior => 'string', default_string => 'none', }, { name => 'double', description => 'Checking of double-quote strings.', behavior => 'string', default_string => 'all', }, { name => 'heredoc', description => 'Checking of interpolated here-documents.', behavior => 'string', default_string => 'all', }, { name => 'charnames', description => 'Checking of character names \\N{}.', behavior => 'string', default_string => 'version', }, { name => 'foldcase', description => 'Checking of fold case \\F.', behavior => 'string', default_string => 'version', }); use constant default_severity => $Perl::Critic::Utils::SEVERITY_MEDIUM; use constant default_themes => qw(pulp cosmetic); sub applies_to { my ($policy) = @_; return (($policy->{'_single'} ne 'none' ? ('PPI::Token::Quote::Single', # '' 'PPI::Token::Quote::Literal') # q{} : ()), ($policy->{'_single'} ne 'none' || $policy->{'_double'} ne 'none' ? ('PPI::Token::QuoteLike::Command') # qx{} or qx'' : ()), ($policy->{'_double'} ne 'none' ? ('PPI::Token::Quote::Double', # "" 'PPI::Token::Quote::Interpolate', # qq{} 'PPI::Token::QuoteLike::Backtick') # `` : ()), ($policy->{'_heredoc'} ne 'none' ? ('PPI::Token::HereDoc') : ())); } # for violation messages my %charname = ("\n" => '{newline}', "\r" => '{cr}', "\t" => '{tab}', " " => '{space}'); use constant _KNOWN => ( 't' # \t tab . 'n' # \n newline . 'r' # \r carriage return . 'f' # \f form feed . 'b' # \b backspace . 'a' # \a bell . 'e' # \e esc . '0123' # \377 octal . 'x' # \xFF \x{FF} hex . 'c' # \cX control char . 'l' # \l lowercase one char . 'u' # \u uppercase one char . 'L' # \L lowercase string . 'U' # \U uppercase string . 'E' # \E end case or quote . 'Q' # \Q quotemeta . '$' # non-interpolation . '@' # non-interpolation ); use constant _CONTROL_KNOWN => '?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_abcdefghijklmnopqrstuvwxyz'; ## no critic (RequireInterpolationOfMetachars) my $quotelike_re = qr/^(?:(q[qrwx]?) # $1 "q" if present (?:(?:\s(?:\s*\#[^\n]*\n)*)\s*)? # possible comments )? # possible "q" (.) # $2 opening quote (.*) # $3 guts (.)$ # $4 closing quote /xs; # extra explanation for double-quote interpolations my %explain = ('%' => ' (hashes are not interpolated)', '&' => ' (function calls are not interpolated)', '4' => ' (until Perl 5.6 octal wide chars)', '5' => ' (until Perl 5.6 octal wide chars)', '6' => ' (until Perl 5.6 octal wide chars)', '7' => ' (until Perl 5.6 octal wide chars)', 'F' => ' (until Perl 5.16)', 'N' => ' (without "use charnames" in scope)', ); my $v5006 = version->new('5.006'); my $v5010 = version->new('5.010'); my $v5016 = version->new('5.016'); sub violates { my ($self, $elem, $document) = @_; my $have_perl_516; if (defined (my $doc_version = $document->highest_explicit_perl_version)) { $have_perl_516 = ($doc_version >= $v5016); } my $content = $elem->content; my $close = substr ($content, -1, 1); my $single = 0; my ($param, $str); if ($elem->isa('PPI::Token::HereDoc')) { return if ($close eq "'"); # uninterpolated $param = $self->{_heredoc}; $str = join ('', $elem->heredoc); } else { if ($elem->can('string')) { $str = $elem->string; } else { $elem =~ $quotelike_re or die "Oops, didn't match quotelike_re"; $str = $3; } $str =~ s{((^|\G|[^\\])(\\\\)*)\\\Q$close}{$close}sg; if ($elem->isa('PPI::Token::Quote::Single') || $elem->isa('PPI::Token::Quote::Literal') || ($elem->isa('PPI::Token::QuoteLike::Command') && $close eq "'")) { $single = 1; $param = $self->{_single}; } else { $param = $self->{_double}; } } return if ($param eq 'none'); my $known = $close; if (! $single) { $known .= _KNOWN; # Octal chars above \377 are in 5.6 up. # Consider known if no "use 5.x" at all, or if present and 5.6 up, # so only under explicit "use 5.005" or lower are they not allowed. my $perlver = $document->highest_explicit_perl_version; if (! defined $perlver || $perlver >= $v5006) { $known .= '4567'; } # \F is in 5.16 up. if ($self->{_foldcase} ne 'disallow' && ($self->{_foldcase} eq 'allow' || (defined $perlver && $perlver >= $v5010))) { $known .= 'F'; } } ### elem: ref $elem ### $content ### $str ### close char: $close ### $known ### perlver: $document->highest_explicit_perl_version my $have_use_charnames; my $interpolate_var_end = -1; my $interpolate_var_colon; my @violations; while ($str =~ /(\$. # $ not at end-of-string |\@[[:alnum:]:'\{\$+-]) # @ forms per toke.c S_scan_const() |(\\+) # $2 run of backslashes /sgx) { if (defined $1) { # $ or @ unless ($single) { # no variables in single-quote ### interpolation at: pos($str) my $new_pos = _pos_after_interpolate_variable ($str, pos($str) - length($1)) || last; pos($str) = $new_pos; ### ends at: pos($str) if (substr($str,pos($str)-1,1) =~ /(\w)|[]}]/) { $interpolate_var_colon = $1; $interpolate_var_end = pos($str); ### interpolate_var_end set to: $interpolate_var_end } } next; } if ((length($2) & 1) == 0) { # even number of backslashes, not an escape next; } # shouldn't have \ as the last char in $str, but if that happends then # $c is empty string '' my $c = substr($str,pos($str),1); pos($str)++; if (! $single) { if ($c eq 'N') { if ($self->{_charnames} eq 'disallow') { push @violations, $self->violation ('charnames \\N disallowed by config', '', $elem); next; } elsif ($self->{_charnames} eq 'allow') { next; # ok, allow by config } else { # $self->{_charnames} eq 'version' if (! defined $have_use_charnames) { $have_use_charnames = _have_use_charnames_in_scope($elem); } if ($have_use_charnames || $have_perl_516) { next; # ok if "use charnames" or perl 5.16 up (which autoloads that) } } } elsif ($c eq 'c') { # \cX control char. # If \c is at end-of-string then new $c is '' and pos() will goes past # length($str). That pos() is ok, the loop regexp gives no-match and # terminates. $c = substr ($str, pos($str)++, 1); if ($c eq '') { push @violations, $self->violation ('Control char \\c at end of string', '', $elem); next; } if (index (_CONTROL_KNOWN, $c) >= 0) { next; # a known escape } push @violations, $self->violation ('Unknown control char \\c' . _printable($c), '', $elem); next; } elsif ($c eq ':') { if ($interpolate_var_colon) { ### backslash colon, pos: pos($str) ### $interpolate_var_end ### substr: substr ($str, $interpolate_var_end, 2) if (pos($str) == $interpolate_var_end+2 || (pos($str) == $interpolate_var_end+4 && substr ($str, $interpolate_var_end, 2) eq '\\:')) { next; } } } elsif ($c eq '[' || $c eq '{') { ### backslash bracket, pos: pos($str) ### $interpolate_var_end if (pos($str) == $interpolate_var_end+2) { next; } } elsif ($c eq '-') { ### backslash dash: pos($str) if ($str =~ /\G>[[{]/) { ### is for bracket or brace, pos now: pos($str) next; } } } if ($param eq 'quotemeta') { # only report on chars quotemeta leaves unchanged next if $c ne quotemeta($c); } elsif ($param eq 'alnum') { # only report unknown alphanumerics, like perl does # believe perl only reports ascii alnums as bad, wide char alphas ok next if $c !~ /[a-zA-Z0-9]/; } # if $c eq '' for end-of-string then index() returns 0, for no violation if (index ($known, $c) >= 0) { # a known escape next; } my $explain = !$single && ($explain{$c} || ''); my $message = ('Unknown or unnecessary backslash \\'._printable($c) . $explain); push @violations, $self->violation ($message, '', $elem); # would have to take into account HereDoc begins on next line ... # _violation_elem_offset ($violation, $elem, pos($str)-2); } return @violations; } # $pos is a position within $str of a "$" or "@" interpolation. # Return the position within $str after that variable or expression. # # FIXME: Would like PPI to do this. Its PPI::Token::Quote::Double version # 1.236 interpolations() has a comment that returning the expressions would # be good. # sub _pos_after_interpolate_variable { my ($str, $pos) = @_; $str = substr ($str, $pos); ### _pos_after_interpolate_variable() ... ### $str # PPI circa 1.236 doesn't like to parse non-ascii as program code # identifiers etc, try changing to spaces for measuring. # # Might be happy for it to parse the interpolate expression and ignore # anything bad after, but PPI::Tokenizer crunches a whole line at a time # or something like that. # $str =~ s/[^[:print:]\t\r\n]/ /g; require PPI::Document; my $doc = PPI::Document->new(\$str); my $elem = $doc && $doc->child(0); $elem = $elem && $elem->child(0); if (! $elem) { warn "ProhibitUnknownBackslash: oops, cannot parse interpolation, skipping string"; return undef; } ### elem: ref $elem ### length: length($elem->content) $pos += length($elem->content); if ($elem->isa('PPI::Token::Cast')) { # get the PPI::Structure::Block following "$" or "@", can have # whitespace before it too while ($elem = $elem->next_sibling) { ### and: "$elem" ### length: length($elem->content) $pos += length($elem->content); last if $elem->isa('PPI::Structure::Block'); } } elsif ($elem->isa('PPI::Token::Symbol')) { # any subscripts 'PPI::Structure::Subscript' following, like "$hash{...}" # whitespace stops the subscripts, so that Struct alone for (;;) { $elem = $elem->next_sibling || last; $elem->isa('PPI::Structure::Subscript') || last; ### and: "$elem" ### length: length($elem->content) $pos += length($elem->content); } } return $pos; } # use Perl::Critic::Policy::Compatibility::PodMinimumVersion; sub _violation_elem_offset { my ($violation, $elem, $offset) = @_; return $violation; # # my $pre = substr ($elem->content, 0, $offset); # my $newlines = ($pre =~ tr/\n//); # # my $document = $elem->document; # my $doc_str = $document->content; # # return Perl::Critic::Pulp::Utils::_violation_override_linenum ($violation, $doc_str, $newlines - 1); } sub _printable { my ($c) = @_; $c =~ s{([^[:graph:]]|[^[:ascii:]])} { $charname{$1} || sprintf('{0x%X}',ord($1)) }e; return $c; } # return true if $elem has a 'use charnames' in its lexical scope sub _have_use_charnames_in_scope { my ($elem) = @_; for (;;) { $elem = $elem->sprevious_sibling || $elem->parent || return 0; if ($elem->isa ('PPI::Statement::Include') && $elem->type eq 'use' && ($elem->module || '') eq 'charnames') { return 1; } } } #----------------------------------------------------------------------------- # unused bits # # $elem is a PPI::Token::Quote, PPI::Token::QuoteLike or PPI::Token::HereDoc # sub _string { # my ($elem) = @_; # if ($elem->can('heredoc')) { # return join ('', $elem->heredoc); # } # if ($elem->can('string')) { # return $elem->string; # } # $elem =~ $quotelike_re # or die "Oops, didn't match quote_re"; # return $3; # } # # $elem is a PPI::Token::Quote or PPI::Token::QuoteLike # # return ($q, $open, $close) where $q is the "q" intro or empty string if # # none, and $open and $close are the quote chars # sub _quote_delims { # my ($elem) = @_; # if ($elem->can('heredoc')) { # return '"', '"'; # } # $elem =~ $quotelike_re # or die "Oops, didn't match quote_re"; # return ($1||'', $2, $4); # } # perlop "Quote and Quote-like Operators" # my $known = ''; # if ($elem->isa ('PPI::Token::Quote::Double') # || $elem->isa ('PPI::Token::Quote::Interpolate') # || $elem->isa ('PPI::Token::QuoteLike::Backtick') # || ($elem->isa ('PPI::Token::QuoteLike::Command') # && $close ne '\'') # no interpolation in qx'echo hi' # ) { # $known = 'tnrfbae0123xcluLUQE$@'; # # # \N and octals bigger than 8-bits are in 5.6 up, and allow them if no # # "use 5.x" at all too # my $perlver = $document->highest_explicit_perl_version; # if (! defined $perlver || $perlver >= 5.006) { # $known .= 'N456789'; # } # } # $known .= $close; # # my $re = qr/\\+[^\\$known$close]/; # my $unknown = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ'; # $unknown =~ s{(.)} # {index($known,$1) >= 0 ? '' : $1}eg; 1; __END__ =for stopwords backslashed upcase FS unicode ascii non-ascii ok alnum quotemeta backslashing backticks Ryde coderef alphanumerics arrowed =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::ProhibitUnknownBackslash - don't use undefined backslash forms =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It checks for unknown backslash escapes like print "\*.c"; # bad This is harmless, assuming the intention is a literal "*" (which it becomes), but unnecessary, and on that basis this policy is under the C theme (see L). Sometimes it can be a misunderstanding or a typo though, for instance a backslashed newline is a newline, but perhaps you thought it meant a continuation. print "this\ # bad is a newline"; Perl already warns about unknown escaped alphanumerics like C<\v> under C or C (see L). print "\v"; # bad, and provokes Perl warning This policy extends to report on any unknown escape, with options below to vary the strictness and to check single-quote strings too if desired. =head2 Control Characters \c Control characters C<\cX> are checked and only the conventional A-Z a-z @ [ \ ] ^ _ ? are considered known. print "\c*"; # bad Perl accepts any C<\c> and does an upcase xor 0x40, so C<\c*> is letter "j", at least on an ASCII system. But that's obscure and likely to be a mistake. For reference, C<\c\> is the ASCII FS "file separator" and the second backslash is not an escape, except for a closing quote character, which it does escape (Perl scans for unescaped closing quote first). Thus, print " \c\ "; # ok, control-\ FS print " \c\" "; # bad, control-" is unknown print qq[ \c\] ]; # ok, control-] GS =head2 Ending Interpolation A backslashed C<:>, C<[>, C<{>, C<-> is allowed after an interpolated variable or element, since the backslash stops interpolation at that point. print "$foo\::bar"; # ok, $foo print "@foo\::"; # ok, @foo print "$foo[0]\[1]"; # ok, is $foo[0] print "$esc\[1m"; # ok print "$foo\{k}"; # ok print "$foo\{k}"; # ok print "$foo{k}\[0]"; # ok, is $foo{k} print "@foo\{1,2}"; # ok, is @foo print "$foo\->[0]"; # ok, is $foo print "$foo\->{zz}"; # ok A single backslash like C<"\::"> is enough for the colon case, but backslashing the second too as C<"\:\:"> is quite common and is allowed. print "$#foo\:\:bar"; # ok Only an array or hash C<-E[]> or C<-E{}> need C<\-> to stop interpolation. Other cases such as an apparent method call or arrowed coderef call don't interpolate and the backslash is treated as unknown since unnecessary. print "$coderef\->(123)"; # bad, unnecessary print "Usage: $class\->foo()"; # bad, unnecessary For reference, the alternative in all the above is to write C<{}> braces around the variable or element to delimit from anything following. Doing so may be clearer than backslashing, print "${foo}::bar"; # alternatives print "@{foo}::bar"; print "$#{foo}th"; print "${foo[0]}[1]"; # array element $foo[0] The full horror story of backslashing interpolations can be found in L. =head2 Octal Wide Chars Octal escapes C<\400> to C<\777> for wide chars 256 to 511 are new in Perl 5.6. They're considered unknown in 5.005 and earlier (where they end up chopped to 8-bits 0 to 255). If there's no C etc Perl version then it's presumed a high octal is intentional and is allowed. print "\400"; # ok use 5.006; print "\777"; # ok use 5.005; print "\777"; # bad in 5.005 and earlier =head2 Fold Case The C<\F> fold case escape (equivalent to built-in function C) is new in Perl 5.16. It's considered unknown in earlier versions (and it provokes a warning when run there). use 5.016; print "\Fxyz"; # ok use 5.010; print "\Fxyz"; # bad prior to 5.16 The C option (L below) can be set to "allow" to always allow C<\F>, as for instance if you always have Perl 5.16 up but without declaring that in a C statement. =head2 Named Chars Named chars C<\N{SOME THING}> are added by L, new in Perl 5.6. In Perl 5.16 up, that module is automatically loaded when C<\N> is used. C<\N> is considered known either when C or higher, use 5.016; print "\N{EQUALS SIGN}"; # ok with 5.16 automatic charnames or when C is in the lexical scope, { use charnames ':full'; print "\N{APOSTROPHE}"; # ok } print "\N{COLON}"; # bad, no charnames in lexical scope In Perl 5.6 through 5.14, a C<\N> without C is a compile error so would be seen in those versions immediately anyway. There's no check of the character name appearing in C<\N>. C gives an error for unknown names. The C option (L below) can be set to "allow" to always allow named characters, as for instance if you always have Perl 5.16 up but without declaring that in a C statement. The C option can be "disallow" to always disallow named characters. This is a blanket prohibition rather than an UnknownBackslash as such, but is opposite of the allow option. Disallowing can be a matter of personal preference or perhaps aim to save a little memory or startup time. =head2 Other Notes In the violation messages, a non-ascii or non-graphical escaped char is shown as hex like C<\{0x263A}>, to ensure the message is printable and unambiguous. Interpolated C<$foo> or C<@{expr}> variables and expressions are parsed like Perl does, so backslashes for refs within interpolation are fine, in particular tricks like C<${\scalar ...}> (see L). print "this ${\(some()+thing())}"; # ok =head2 Disabling As always, if you're not interested in any of this then you can disable C from your F<.perlcriticrc> in the usual way (see L), [-ValuesAndExpressions::ProhibitUnknownBackslash] =head1 CONFIGURATION =over 4 =item C (string, default "all") =item C (string, default "all") C applies to double-quote strings C<"">, C, C, etc. C applies to interpolated here-documents CEHERE> etc. The possible values are none don't report anything alnum report unknown alphanumerics, like Perl's warning quotemeta report anything quotemeta() doesn't escape all report all unknowns "alnum" does no more than compiling with C, but might be good for checking code you don't want to run. "quotemeta" reports escapes not produced by C. For example, C doesn't escape an underscore C<_>, so C<\_> is reported. But C does escape C<*>, so C<\*> is allowed. The effect is to prohibit a few more escapes than "alnum". One use is to check code generated by other code where you've used C to produce double-quoted strings and thus may have escaping which is unnecessary but works fine. =item C (string, default "none") C applies to single-quote strings C<''>, C, C, etc. The possible values are as above, though only "all" or "none" make much sense. none don't report anything all report all unknowns The default is "none" because literal backslashes in single-quotes are usually both what you want and quite convenient. Setting "all" effectively means you must write backslashes as C<\\>. print 'c:\my\msdos\filename'; # bad under "single=all" print 'c:\\my\\msdos\\filename'; # ok Doubled backslashing like this is correct, and can emphasize that you really did want a backslash, but it's tedious and not easy on the eye and so left only as an option. For reference, single-quote here-documents CE'HERE'> don't have any backslash escapes and so are not considered by this policy. C command backticks are double-quote but C is single-quote. They're treated per the corresponding C or C option. =item C (string, default "version") Whether to treat the fold case escape C<\F> in double-quote strings as known or unknown, version known if use 5.016 allow always allow disallow always disallow =item C (string, default "version") Whether to treat named characters C<\N{}> in double-quote strings as known or unknown, version known if use charnames or use 5.016 allow always allow disallow always disallow =back =head1 BUGS Interpolations in double-quote strings are found by some code here in C (re-parse the string content as Perl code starting from the C<$> or C<@>). If this fails for some reason then a warning is given and the rest of the string is unchecked. In the future would like PPI to parse interpolations, for the benefit of string chopping like here or checking of code in an interpolation. =head1 SEE ALSO L, L L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021, 2025 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/ValuesAndExpressions/RequireNumericVersion.pm0000644000175000017500000003035514017115127027304 0ustar gggg# Copyright 2011, 2012, 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 . package Perl::Critic::Policy::ValuesAndExpressions::RequireNumericVersion; use 5.006; use strict; use warnings; use Scalar::Util; use version (); # but don't import qv() use base 'Perl::Critic::Policy'; use Perl::Critic::Utils 'precedence_of'; use Perl::Critic::Pulp::Utils; # 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 bugs); use constant applies_to => ('PPI::Token::Symbol'); my $perl_510 = version->new('5.10.0'); my $assignment_precedence = precedence_of('='); our $VERSION = 100; sub violates { my ($self, $elem, $document) = @_; ### NumericVersion violates() ### canonical: $elem->canonical my $package = _symbol_is_mod_VERSION($elem) || return; my $assign = $elem->snext_sibling || return; ### assign: "$assign" $assign eq '=' or return; my $value = $assign->snext_sibling || return; ### value: "$value" if (! $value->isa('PPI::Token::Quote')) { ### an expression, or a number, not a string, so ok ... return; } if (_following_expression ($value)) { ### can't check an expression (though it starts with a string) ... return; } my $str = $value->string; if ($value->isa ('PPI::Token::Quote::Double') || $value->isa ('PPI::Token::Quote::Interpolate')) { ### double quote, check only up to an interpolation $str =~ s/[\$\@].*//; } if (_any_eval_VERSION ($document, $package)) { return; } if (! defined(Perl::Critic::Pulp::Utils::version_if_valid($str))) { return $self->violation ('Non-numeric VERSION string (not recognised by version.pm)', '', $value); } # Float number strings like "1e6" are usually rejected by version.pm, but # have seen perl 5.10 and version.pm 0.88 with pure-perl "version::vpp" # accept them. Not sure why that's so, but explicitly reject to be sure. # Such a string form in fact works in perl 5.8.x but not in 5.10.x. # if ($str =~ /e/i) { return $self->violation ('Non-numeric VERSION string (exponential string like "1e6" no good in perl 5.10 and up)', '', $value); } my $got_perl = $document->highest_explicit_perl_version; if (defined $got_perl && $got_perl >= $perl_510) { # for 5.10 up only need to satisfy version.pm return; } # for 5.8 or unspecified version must be plain number, not "1.2.3" etc if (! Scalar::Util::looks_like_number($str)) { return $self->violation ('Non-numeric VERSION string', '', $value); } return; } sub _following_expression { my ($elem) = @_; my $after = $elem->snext_sibling or return 0; if ($after->isa('PPI::Token::Structure')) { return 0; } elsif ($after->isa('PPI::Token::Operator')) { if (precedence_of($after) >= $assignment_precedence) { return 0; } if ($after eq '.') { return 0; } } return 1; } # $elem is a PPI::Token::Word # return its module, such as "Foo::Bar" # or if it's in "main" then return undef # sub _symbol_is_mod_VERSION { my ($elem) = @_; # canonical() turns $::VERSION into $main::VERSION $elem->canonical =~ /^\$((\w+::)*)VERSION$/ or return undef; # not $VERSION or $Foo::VERSION my $package = substr($1,0,-2); if ($package eq '') { # $elem is an unqualified symbol, find containing "package Foo" my $pelem = Perl::Critic::Pulp::Utils::elem_package($elem) || return undef; # not in a package, not a module $VERSION $package = $pelem->namespace; } if ($package eq 'main') { return undef; # "package main" or "$main::VERSION", not a module } return $package; } # return true if there's a "$VERSION = eval $VERSION" somewhere in # $document, acting on the "$VERSION" of $want_package # sub _any_eval_VERSION { my ($document, $want_package) = @_; my $aref = $document->find('PPI::Token::Symbol') || return 0; foreach my $elem (@$aref) { my $got_package = _symbol_is_mod_VERSION($elem) || next; $got_package eq $want_package || next; my $assign = $elem->snext_sibling || next; $assign eq '=' or next; my $value = $assign->snext_sibling || next; $value->isa('PPI::Token::Word') || next; $value eq 'eval' or next; $value = $value->snext_sibling || next; $value->isa('PPI::Token::Symbol') || next; $got_package = _symbol_is_mod_VERSION($value) || next; $got_package eq $want_package || next; return 1; } return 0; } 1; __END__ =for stopwords toplevel ie CPAN pre-release args exponentials multi-dots v-nums YYYYMMDD Ryde builtin MakeMaker runtime filename =head1 NAME Perl::Critic::Policy::ValuesAndExpressions::RequireNumericVersion - $VERSION a plain number =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you to use a plain number in a module C<$VERSION> so that Perl's builtin version works. Any literal number is fine, or a string which is a number, $VERSION = 123; # ok $VERSION = '1.5'; # ok $VERSION = 1.200_001; # ok For Perl 5.10 and higher the extra forms of the C module too, use 5.010; $VERSION = '1.200_001'; # ok for 5.10 up, version.pm But a non-number string is not allowed, $VERSION = '1.2alpha'; # bad The idea of this requirement is that a plain number is needed for Perl's builtin module version checking like the following, and on that basis this policy is under the "bugs" theme (see L). use Foo 1.0; Foo->VERSION(1); A plain number is also highly desirable so applications can do their own compares like if (Foo->VERSION >= 1.234) { In each case if C<$VERSION> is not a number then it provokes warnings, and may end up appearing as a lesser version than intended. Argument "1.2.alpha" isn't numeric in subroutine entry If you've loaded the C module then a C<$VERSION> not accepted by C will in fact croak, which is an unpleasant variant behaviour. use version (); print "version ",Foo->VERSION,"\n"; # croaks "Invalid version format ..." if $Foo::VERSION is bad =head2 Scripts This policy only looks at C<$VERSION> in modules. C<$VERSION> in a script can be anything since it won't normally be part of C checks etc. A script C<$VERSION> is anything outside any C statement scope, or under an explicit C. package main; $VERSION = '1.5.prerelease'; # ok, script $main::VERSION = 'blah'; # ok, script $::VERSION = 'xyzzy'; # ok, script A fully-qualified package name is recognised as belonging to a module, $Foo::Bar::VERSION = 'xyzzy'; # bad =head2 Underscores in Perl 5.8 and Earlier In Perl 5.8 and earlier a string like "1.200_333" is truncated to the numeric part, ie. 1.200, and can thus fail to satisfy $VERSION = '1.222_333'; # bad use Foo 1.222_331; # not satisfied by $VERSION='string' form But an actual number literal with an "_" is allowed. Underscores in literals are stripped out (see L), but not in the automatic string to number conversion so a string like C<$VERSION = '1.222_333'> provokes a warning and stops at 1.222. $VERSION = 1.222_333; # ok On CPAN an underscore in a distribution version number is rated as a developer pre-release. But don't put it in module C<$VERSION> strings due to the problems above. The suggestion is to include the underscore in the distribution filename but either omit it from the C<$VERSION> or make it a number literal not a string, $VERSION = 1.002003; # ok $VERSION = 1.002_003; # ok, but not for VERSION_FROM C C will take the latter as its numeric value, ie. "1.002003" not "1.002_003" as the distribution version. For the latter you can either put an explicit C in F use ExtUtils::MakeMaker; WriteMakefile (VERSION => '1.002_003'); Or you can trick MakeMaker with a string plus C, $VERSION = '1.002_003'; # ok evalled down $VERSION = eval $VERSION; C sees the string "1.002_003" but at runtime the C crunches it down to a plain number 1.002003. C notices such an C and anything in C<$VERSION>. Something bizarre in C<$VERSION> won't be noticed, but that's too unlikely to worry about. =head2 C module in Perl 5.10 up In Perl 5.10 C etc module version checks parse C<$VERSION> with the C module. This policy allows the C module forms if there's an explicit C or higher in the file. use 5.010; $VERSION = '1.222_333'; # ok for 5.10 $VERSION = '1.2.3'; # ok for 5.10 But this is still undesirable, as an application check like if (Foo->VERSION >= 1.234) { gets the raw string from C<$VERSION> and thus a non-numeric warning and truncation. Perhaps applications should let C do the work with say if (eval { Foo->VERSION(1.234) }) { or apply Cnew()> to one of the args. Maybe another policy to not explicitly compare C<$VERSION>, or perhaps an option to tighten this policy to require numbers even in 5.10? =head2 Exponential Format Exponential strings like "1e6" are disallowed $VERSION = '2.125e6'; # bad Except with the C trick as per above $VERSION = '2.125e6'; # ok $VERSION = eval $VERSION; Exponential number literals are fine. $VERSION = 1e6; # ok Exponential strings don't work in Perl 5.10 because they're not recognised by the C module (v0.82). They're fine in Perl 5.8 and earlier, but in the interests of maximum compatibility this policy treats such a string as non-numeric. Exponentials in versions should be unusual anyway. =head2 Disabling If you don't care about this policy at all then you can disable from your F<.perlcriticrc> in the usual way (see L), [-ValuesAndExpressions::RequireNumericVersion] =head2 Other Ways to Do It The version number system with underscores, multi-dots, v-nums, etc is diabolical mess, and each new addition to it just seems to make it worse. Even the original floating point in version checks is asking for rounding error trouble, though normally fine in practice. A radical simplification is to just use integer version numbers. $VERSION = 123; If you want sub-versions then increment by 100 or some such. Even a YYYYMMDD date is a possibility. $VERSION = 20110328; =head1 SEE ALSO L, L L, L, L L, L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Documentation/0002755000175000017500000000000015071066561021131 5ustar ggggPerl-Critic-Pulp-100/lib/Perl/Critic/Policy/Documentation/RequireFinalCut.pm0000644000175000017500000001522314017115127024522 0ustar gggg# Copyright 2012, 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 RequireFinalCut RequireFinalCut.pm # perlcritic -s RequireFinalCut /usr/share/perl5/Class/InsideOut.pm # perlcritic -s RequireFinalCut /usr/share/perl5/Lingua/Any/Numbers.pm package Perl::Critic::Policy::Documentation::RequireFinalCut; 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 = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOWEST; use constant default_themes => qw(pulp cosmetic); use constant applies_to => 'PPI::Document'; sub violates { my ($self, $elem, $document) = @_; ### RequireFinalCut on: $elem->content my $parser = Perl::Critic::Pulp::PodParser::RequireFinalCut->new (policy => $self); $parser->parse_from_elem ($elem); return $parser->violations; } package Perl::Critic::Pulp::PodParser::RequireFinalCut; use strict; use warnings; use base 'Perl::Critic::Pulp::PodParser'; sub new { my $class = shift; my $self = $class->SUPER::new (@_); $self->parseopts(-process_cut_cmd => 1); return $self; } # Pod::Parser doesn't hold the current line number except in a local # variable, so have to note it here for use in end_input(). # sub begin_input { my $self = shift; $self->SUPER::begin_input(@_); $self->{'last_linenum'} = 0; } sub preprocess_line { my ($self, $line, $linenum) = @_; ### preprocess_line(): "linenum=$linenum" $self->{'last_linenum'} = $linenum; return $line; } sub end_input { my $self = shift; $self->SUPER::begin_input(@_); if ($self->{'in_pod'} && ! $self->{'saw_cut_in_text'}) { $self->violation_at_linenum_and_textpos ("POD doesn't end with =cut directive", $self->{'last_linenum'} + 1, # end of file as the position '', 0); } } sub command { my $self = shift; $self->SUPER::command(@_); my ($command, $text, $linenum, $paraobj) = @_; ### $command ### $text if ($command eq 'cut') { $self->{'in_pod'} = 0; } elsif ($command eq 'end' || $command eq 'for') { } elsif ($command eq 'pod') { $self->{'in_pod'} = 1; } else { unless ($self->{'in_begin'}) { $self->{'in_pod'} = 1; } } ### now in_pod: $self->{'in_pod'} $self->my_notice_cut($text); return ''; } sub verbatim { my ($self, $text, $linenum, $paraobj) = @_; ### verbatim ... # ignore entirely whitespace runs of blank lines return '' if $text =~ /^\s*$/; unless ($self->{'in_begin'}) { $self->{'in_pod'} = 1; } $self->my_notice_cut($text); return ''; } sub textblock { my ($self, $text, $linenum, $paraobj) = @_; ### textblock ... ### $text unless ($self->{'in_begin'}) { $self->{'in_pod'} = 1; } $self->my_notice_cut($text); return ''; } sub my_notice_cut { my ($self, $text) = @_; $self->{'saw_cut_in_text'} = ($text =~ /\n=cut\b[^\n]*/); } 1; __END__ =for stopwords Ryde =head1 NAME Perl::Critic::Policy::Documentation::RequireFinalCut - end POD with =cut directive =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you to end POD with a C<=cut> directive at the end of a file. =head1 DOCO Some text. =cut # ok The idea is to have a definite end indication for human readers. Perl and the POD processors don't require a final C<=cut>. On that basis this policy is lowest severity and under the "cosmetic" theme (see L). If there's no POD in the file then a C<=cut> is not required. Or if the file ends with code rather than POD then a C<=cut> after that code is not required. =head2 About foo =cut sub foo { } # ok, file ends with code not POD If there's POD at end of file but consists only of C<=begin/=end> blocks then a C<=cut> is not required. It's reckoned the C<=end> is enough in this case. =begin wikidoc Entire document in wiki style. =end wikidoc # ok, =cut not required If the file ends with a mixture of ordinary POD and C<=begin> blocks then a is still required. The special allowance is when only C<=begin> blocks, presumably destined for some other markup system. =head2 Blank Line Generally a C<=cut> should have a blank line before it, the same as other POD commands. But Perl execution doesn't enforce that and the same looseness is permitted here, =pod Blah blah blah =cut # ok without preceding newline A check for blanks around POD commands is left to other policies. The C program reports this (L). =cut # The POD parsers vary a little in their treatment of this sort of thing. # C takes it as part of the paragraph, C takes it as # a command but may issue warnings. =pod =head2 Disabling If you don't care about a final C<=cut> you can disable C from your F<.perlcriticrc> in the usual way (see L), [-Documentation::RequireFinalCut] =head1 SEE ALSO L, L L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Documentation/ProhibitParagraphEndComma.pm0000644000175000017500000001336114017115127026473 0ustar gggg# Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020, 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 . # maybe allow comma for # =head1 Foo # And something, # =head2 Item # perlcritic -s ProhibitParagraphEndComma ProhibitParagraphEndComma.pm # perlcritic -s ProhibitParagraphEndComma /usr/share/perl5/IO/Socket/INET6.pm # perlcritic -s ProhibitParagraphEndComma /usr/share/perl5/MIME/Body.pm /usr/share/perl5/XML/Twig.pm package Perl::Critic::Policy::Documentation::ProhibitParagraphEndComma; 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 = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOWEST; use constant default_themes => qw(pulp cosmetic); use constant applies_to => 'PPI::Document'; sub violates { my ($self, $elem, $document) = @_; ### ProhibitParagraphEndComma on: $elem->content my $parser = Perl::Critic::Pulp::PodParser::ProhibitParagraphEndComma->new (policy => $self); $parser->parse_from_elem ($elem); $parser->check_last; return $parser->violations; } package Perl::Critic::Pulp::PodParser::ProhibitParagraphEndComma; use strict; use warnings; 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 # "=begin :foo" means pod markup continues. Ignore the =begin and # continue processing POD within it. Any other begin is a new block # something and preceding comma not allowed. # if ($command eq 'for' || $command eq 'pod' || ($command eq 'begin' && $text =~ /^\s*:/) || $command eq 'end') { return; # ignore these completely } if ($command eq 'item' && $self->{'last_command'} eq 'item') { # Paragraphs in =item list can end in successive commas. } elsif ($command eq 'over') { } else { $self->check_last; } $self->{'last_text'} = ''; $self->{'last_command'} = $command; } sub textblock { my ($self, $text, $linenum, $paraobj) = @_; ### textblock(): $text $self->check_last; # sometimes $text=undef from Pod::Parser if (! defined $text) { $text = ''; } $self->{'last_linenum'} = $linenum; $self->{'last_text'} = $text; } sub verbatim { my ($self, $text, $linenum, $paraobj) = @_; # anything before a verbatim is ok $self->{'last_text'} = ''; } sub check_last { my ($self) = @_; ### check_last() ... ### in_begin: $self->{'in_begin'} if ($self->{'in_begin'} && $self->{'in_begin'} !~ /^:/) { # =begin block of non-: means not pod markup } elsif ($self->{'last_text'} =~ /(,\s*)$/s) { ### last_text ends comma ... my $pos = length($self->{'last_text'}) - length($1); # position of comma $self->violation_at_linenum_and_textpos ("Paragraph ends with comma", $self->{'last_linenum'}, $self->{'last_text'}, $pos); } $self->{'last_text'} = ''; } 1; __END__ =for stopwords Ryde =head1 NAME Perl::Critic::Policy::Documentation::ProhibitParagraphEndComma - avoid comma at end of section =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you not to end a POD paragraph with a comma. Some text, # bad, meant to be a full-stop? Some more text. Usually such a comma is meant to be a full-stop, or perhaps omitted at the end of a "SEE ALSO" list =for ProhibitVerbatimMarkup allow next 2 =head1 SEE ALSO L, L, # bad, meant to be omitted? A paragraph is allowed to end with a comma when before an C<=over> or a verbatim block, that being taken as introducing a quotation or example, For example, # ok, introduce an example foo(1+2+3) Or one of, # ok, introduce an itemized list =over =item Foo =head2 Disabling If you don't care about this you can disable C from your F<.perlcriticrc> in the usual way (see L), [-Documentation::ProhibitParagraphEndComma] =head1 SEE ALSO L, L L =head1 HOME PAGE http://user42.tuxfamily.org/perl-critic-pulp/index.html =head1 COPYRIGHT Copyright 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2020, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Documentation/ProhibitParagraphTwoDots.pm0000644000175000017500000001235114017115127026411 0ustar gggg# Copyright 2011, 2012, 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 ProhibitParagraphTwoDots ProhibitParagraphTwoDots.pm # perlcritic -s ProhibitParagraphTwoDots /usr/share/perl5/HTML/FormatText/WithLinks.pm # Maybe foo.Z<>. to disguise two dots? package Perl::Critic::Policy::Documentation::ProhibitParagraphTwoDots; 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 = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOWEST; use constant default_themes => qw(pulp cosmetic); use constant applies_to => 'PPI::Document'; sub violates { my ($self, $elem, $document) = @_; ### ProhibitParagraphTwoDots on: $elem->content my $parser = Perl::Critic::Pulp::PodParser::ProhibitParagraphTwoDots->new (policy => $self); $parser->parse_from_elem ($elem); return $parser->violations; } package Perl::Critic::Pulp::PodParser::ProhibitParagraphTwoDots; use strict; use warnings; use Pod::ParseLink; use base 'Perl::Critic::Pulp::PodParser'; sub command { my $self = shift; $self->SUPER::command(@_); # maintain 'in_begin' return $self->command_as_textblock(@_); } sub textblock { my ($self, $text, $linenum, $pod_para) = @_; ### textblock: "linenum=$linenum" # "=begin :foo" is markup, check it. Other =begin is not markup. unless ($self->{'in_begin'} eq '' || $self->{'in_begin'} =~ /^:/) { return ''; } my $str = $self->interpolate($text, $linenum); ### $text ### $str if ($str =~ /(?violation_at_linenum_and_textpos ("Paragraph ends with two dots (stray extra?)", $linenum, $text, $pos); } return ''; } sub interior_sequence { my ($self, $cmd, $text, $pod_seq) = @_; if ($cmd eq 'X') { # index entry, no text output, but keep newlines for linenum $text =~ tr/\n//cd; } elsif ($cmd eq 'L') { my ($display, $inferred, $name, $section, $type) = Pod::ParseLink::parselink ($text); ### $display ### $inferred ### $name return $inferred; # the display part, or the name part if no display } return $text; } 1; __END__ =for stopwords Ryde =head1 NAME Perl::Critic::Policy::Documentation::ProhibitParagraphTwoDots - don't end a paragraph with two dots =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It asks you not to end a POD paragraph with two dots, Some thing.. # bad This is a surprisingly easy typo, but of course is entirely cosmetic and on that basis this policy is lowest severity and under the "cosmetic" theme (see L). Three or more dots as an ellipsis is fine, And some more of this ... # ok and anything within a paragraph is fine, Numbers 1 .. 10 are handled. # ok Only text paragraphs are checked. Verbatim paragraphs can end with anything at all This is an example, example_code (1 .. # ok There might be other dubious paragraph endings this policy could pick up, but things like ";." or ":." can arise from code or smiley faces, so at the moment only two dots are bad. =head2 Disabling If you don't care about this you can disable C from your F<.perlcriticrc> in the usual way (see L), [-Documentation::ProhibitParagraphTwoDots] A C<## no critic> directive works in new enough C, but if you have an C<__END__> token then any C generally must be before that. =head1 SEE ALSO L, L L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Documentation/RequireEndBeforeLastPod.pm0000644000175000017500000001207614017115127026140 0ustar gggg# Copyright 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2017, 2019, 2021 Kevin Rydepod # 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 Perl::Critic::Policy::Documentation::RequireEndBeforeLastPod; use 5.006; use strict; use warnings; use base 'Perl::Critic::Policy'; use Perl::Critic::Utils; our $VERSION = 100; use constant supported_parameters => (); use constant default_severity => $Perl::Critic::Utils::SEVERITY_LOW; use constant default_themes => qw(pulp cosmetic); use constant applies_to => 'PPI::Document'; # only ever gives one violation use constant default_maximum_violations_per_document => 1; sub violates { my ($self, $elem, $document) = @_; $elem = $elem->last_element || return; # empty file if ($elem->isa('PPI::Statement::End') || $elem->isa('PPI::Statement::Data')) { # $document ends with __END__, ok # or ends with __DATA__, in which case you can't use __END__ after last # code, so ok return; } for (;;) { if ($elem->significant) { # document ends with code, ie. no pod after the last code, so ok return; } if ($elem->isa('PPI::Token::Pod')) { # found the last pod last; } # otherwise skip PPI::Token::Comment and possibly PPI::Token::Whitespace $elem = $elem->previous_sibling || return; # $document is empty, or only comments and whitespace, so ok } if (! $elem->sprevious_sibling) { # there's no code before the last pod, either a pod-only file, or pod # plus comments etc, so ok return; } return $self->violation ('Put __END__ before POD at the end of a file.', '', $elem); } 1; __END__ =for stopwords ok SelfLoader Ryde =head1 NAME Perl::Critic::Policy::Documentation::RequireEndBeforeLastPod - require __END__ before POD at end of file =head1 DESCRIPTION This policy is part of the L|Perl::Critic::Pulp> add-on. It requires that you put an C<__END__> before POD which is at the end of a file. For example, program_code(); 1; __END__ # good =head1 NAME ... and not merely program_code(); 1; # bad =head1 NAME ... This is primarily a matter of personal preference, so the policy is low severity and only under the "cosmetic" theme (see L). An C<__END__> like this has no effect on execution, but it's a fairly common convention since it's a good human indication you mean the code to end there, and it stops Perl parsing through the POD which may save a few nanoseconds. This policy is looser than C. This policy allows POD to be anywhere in among the code, the requirement is only that if the file ends with POD then you should have an C<__END__> between the last code and last POD. A file of all POD, or all code, or which ends with code, is ok. Ending with code is usual if you write your POD at the start of the file or in among the functions etc, =pod And that's all. =cut cleanup (); exit 0; # good A file using C<__DATA__> is always ok, since you can't have C<__END__> followed by C<__DATA__>, wherever you want your POD. If the C<__DATA__> is in fact C code then it can helpfully have an C<__END__> within it, but as of C version 1.092 no checks at all are applied to SelfLoader sections. =head2 Disabling As always if you don't care about C<__END__> you can disable C from your F<.perlcriticrc> in the usual way (see L), [-Documentation::RequireEndBeforeLastPod] =head1 SEE ALSO L, L, L =head1 HOME PAGE L =head1 COPYRIGHT Copyright 2008, 2009, 2010, 2011, 2012, 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 Perl-Critic-Pulp-100/lib/Perl/Critic/Policy/Documentation/ProhibitAdjacentLinks.pm0000644000175000017500000001653714017115127025704 0ustar gggg# Copyright 2010, 2011, 2012, 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 . package Perl::Critic::Policy::Documentation::ProhibitAdjacentLinks; 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; # perlcritic -s ProhibitAdjacentLinks ProhibitAdjacentLinks.pm # perlcritic -s ProhibitAdjacentLinks /usr/share/perl5/SVG.pm # cf /usr/lib/perl5/Template/Context.pm # L