From 12679ab7d3c2a210f4123163671b532b8b55d5f9 Mon Sep 17 00:00:00 2001 From: Norbert Preining Date: Fri, 15 Mar 2024 03:06:35 +0000 Subject: CTAN sync 202403150306 --- .../tlnet/tlpkg/tlperl/site/lib/App/Prove.pm | 817 ++++++++ .../tlnet/tlpkg/tlperl/site/lib/App/Prove/State.pm | 548 +++++ .../tlperl/site/lib/App/Prove/State/Result.pm | 233 +++ .../tlperl/site/lib/App/Prove/State/Result/Test.pm | 152 ++ .../tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS.pm | 66 +- .../tlnet/tlpkg/tlperl/site/lib/Digest/SHA.pm | 18 +- .../tlnet/tlpkg/tlperl/site/lib/ExtUtils/Config.pm | 114 + .../tlpkg/tlperl/site/lib/ExtUtils/Helpers.pm | 131 ++ .../tlpkg/tlperl/site/lib/ExtUtils/Helpers/Unix.pm | 86 + .../tlpkg/tlperl/site/lib/ExtUtils/Helpers/VMS.pm | 117 ++ .../tlperl/site/lib/ExtUtils/Helpers/Windows.pm | 70 + .../tlpkg/tlperl/site/lib/ExtUtils/InstallPaths.pm | 625 ++++++ .../tlnet/tlpkg/tlperl/site/lib/File/Listing.pm | 18 +- .../tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm | 158 +- .../tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm | 6 +- .../tlperl/site/lib/HTTP/Cookies/Microsoft.pm | 4 +- .../tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm | 4 +- .../tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm | 78 +- .../tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm | 13 +- systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm | 671 ------ .../tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm | 86 - .../tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm | 80 - .../tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm | 183 -- .../tlnet/tlpkg/tlperl/site/lib/LWP/ConnCache.pm | 350 ---- .../tlnet/tlpkg/tlperl/site/lib/LWP/Debug.pm | 112 - .../tlpkg/tlperl/site/lib/LWP/Debug/TraceHTTP.pm | 29 - .../tlnet/tlpkg/tlperl/site/lib/LWP/DebugFile.pm | 7 - .../tlnet/tlpkg/tlperl/site/lib/LWP/MemberMixin.pm | 48 - .../tlnet/tlpkg/tlperl/site/lib/LWP/Protocol.pm | 313 --- .../tlpkg/tlperl/site/lib/LWP/Protocol/cpan.pm | 72 - .../tlpkg/tlperl/site/lib/LWP/Protocol/data.pm | 52 - .../tlpkg/tlperl/site/lib/LWP/Protocol/file.pm | 147 -- .../tlpkg/tlperl/site/lib/LWP/Protocol/ftp.pm | 555 ----- .../tlpkg/tlperl/site/lib/LWP/Protocol/gopher.pm | 213 -- .../tlpkg/tlperl/site/lib/LWP/Protocol/http.pm | 523 ----- .../tlpkg/tlperl/site/lib/LWP/Protocol/loopback.pm | 27 - .../tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm | 184 -- .../tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm | 150 -- .../tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm | 25 - .../tlnet/tlpkg/tlperl/site/lib/LWP/RobotUA.pm | 312 --- .../tlnet/tlpkg/tlperl/site/lib/LWP/Simple.pm | 267 --- .../tlnet/tlpkg/tlperl/site/lib/LWP/UserAgent.pm | 2179 -------------------- .../tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm | 22 +- .../tlpkg/tlperl/site/lib/Module/Build/Tiny.pm | 349 ++++ .../tlnet/tlpkg/tlperl/site/lib/Mozilla/CA.pm | 21 +- .../tlpkg/tlperl/site/lib/Mozilla/CA/cacert.pem | 1274 ++++++++---- .../tlpkg/tlperl/site/lib/Mozilla/mk-ca-bundle.pl | 625 ------ .../tlnet/tlpkg/tlperl/site/lib/Net/HTTP.pm | 4 +- .../tlpkg/tlperl/site/lib/Net/HTTP/Methods.pm | 4 +- .../tlnet/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm | 4 +- .../tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm | 4 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/Socket.pm | 1143 ++++++++++ .../tlnet/tlpkg/tlperl/site/lib/TAP/Base.pm | 133 ++ .../tlpkg/tlperl/site/lib/TAP/Formatter/Base.pm | 490 +++++ .../tlpkg/tlperl/site/lib/TAP/Formatter/Color.pm | 116 ++ .../tlpkg/tlperl/site/lib/TAP/Formatter/Console.pm | 100 + .../lib/TAP/Formatter/Console/ParallelSession.pm | 201 ++ .../site/lib/TAP/Formatter/Console/Session.pm | 205 ++ .../tlpkg/tlperl/site/lib/TAP/Formatter/File.pm | 56 + .../tlperl/site/lib/TAP/Formatter/File/Session.pm | 95 + .../tlpkg/tlperl/site/lib/TAP/Formatter/Session.pm | 220 ++ .../tlnet/tlpkg/tlperl/site/lib/TAP/Harness.pm | 1072 ++++++++++ .../tlpkg/tlperl/site/lib/TAP/Harness/Beyond.pod | 426 ++++ .../tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Env.pm | 215 ++ .../tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm | 155 ++ .../tlnet/tlpkg/tlperl/site/lib/TAP/Parser.pm | 1931 +++++++++++++++++ .../tlpkg/tlperl/site/lib/TAP/Parser/Aggregator.pm | 414 ++++ .../tlpkg/tlperl/site/lib/TAP/Parser/Grammar.pm | 590 ++++++ .../tlpkg/tlperl/site/lib/TAP/Parser/Iterator.pm | 162 ++ .../tlperl/site/lib/TAP/Parser/Iterator/Array.pm | 100 + .../tlperl/site/lib/TAP/Parser/Iterator/Process.pm | 381 ++++ .../tlperl/site/lib/TAP/Parser/Iterator/Stream.pm | 116 ++ .../tlperl/site/lib/TAP/Parser/IteratorFactory.pm | 339 +++ .../tlperl/site/lib/TAP/Parser/Multiplexer.pm | 196 ++ .../tlpkg/tlperl/site/lib/TAP/Parser/Result.pm | 297 +++ .../tlperl/site/lib/TAP/Parser/Result/Bailout.pm | 62 + .../tlperl/site/lib/TAP/Parser/Result/Comment.pm | 60 + .../tlperl/site/lib/TAP/Parser/Result/Plan.pm | 119 ++ .../tlperl/site/lib/TAP/Parser/Result/Pragma.pm | 62 + .../tlperl/site/lib/TAP/Parser/Result/Test.pm | 271 +++ .../tlperl/site/lib/TAP/Parser/Result/Unknown.pm | 48 + .../tlperl/site/lib/TAP/Parser/Result/Version.pm | 62 + .../tlperl/site/lib/TAP/Parser/Result/YAML.pm | 61 + .../tlperl/site/lib/TAP/Parser/ResultFactory.pm | 183 ++ .../tlpkg/tlperl/site/lib/TAP/Parser/Scheduler.pm | 448 ++++ .../tlperl/site/lib/TAP/Parser/Scheduler/Job.pm | 127 ++ .../site/lib/TAP/Parser/Scheduler/Spinner.pm | 61 + .../tlpkg/tlperl/site/lib/TAP/Parser/Source.pm | 381 ++++ .../tlperl/site/lib/TAP/Parser/SourceHandler.pm | 191 ++ .../lib/TAP/Parser/SourceHandler/Executable.pm | 187 ++ .../site/lib/TAP/Parser/SourceHandler/File.pm | 136 ++ .../site/lib/TAP/Parser/SourceHandler/Handle.pm | 124 ++ .../site/lib/TAP/Parser/SourceHandler/Perl.pm | 372 ++++ .../site/lib/TAP/Parser/SourceHandler/RawTAP.pm | 130 ++ .../tlperl/site/lib/TAP/Parser/YAMLish/Reader.pm | 347 ++++ .../tlperl/site/lib/TAP/Parser/YAMLish/Writer.pm | 263 +++ .../tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm | 30 +- .../tlnet/tlpkg/tlperl/site/lib/Test/HACKING.pod | 264 +++ .../tlnet/tlpkg/tlperl/site/lib/Test/Harness.pm | 618 ++++++ .../tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm | 8 +- .../tlnet/tlpkg/tlperl/site/lib/Test/Warnings.pm | 587 ++++++ systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm | 202 +- .../tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm | 45 +- .../tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm | 190 +- .../tlnet/tlpkg/tlperl/site/lib/URI/Split.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm | 33 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_login.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm | 22 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_query.pm | 99 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_server.pm | 9 +- .../tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm | 6 +- .../tlnet/tlpkg/tlperl/site/lib/URI/data.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/file.pm | 23 +- .../tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm | 418 ++++ .../tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/http.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/https.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/icap.pm | 76 + .../tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm | 76 + .../tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/news.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm | 42 +- .../tlnet/tlpkg/tlperl/site/lib/URI/sips.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/snews.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm | 2 +- .../texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm | 6 +- .../tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm | 2 +- .../tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm | 2 +- .../tlperl/site/lib/auto/Cpanel/JSON/XS/.packlist | 15 +- .../tlperl/site/lib/auto/Cpanel/JSON/XS/XS.dll | Bin 103936 -> 67072 bytes .../tlperl/site/lib/auto/Cpanel/JSON/XS/XS.exp | Bin 0 -> 909 bytes .../tlperl/site/lib/auto/Cpanel/JSON/XS/XS.lib | Bin 0 -> 1708 bytes .../tlperl/site/lib/auto/Cpanel/JSON/XS/XS.pdb | Bin 0 -> 733184 bytes .../tlperl/site/lib/auto/Date/Parse/.packlist | 78 +- .../tlperl/site/lib/auto/Digest/SHA/.packlist | 11 +- .../tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.dll | Bin 47616 -> 41984 bytes .../tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.exp | Bin 0 -> 887 bytes .../tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.lib | Bin 0 -> 1694 bytes .../tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.pdb | Bin 0 -> 602112 bytes .../tlperl/site/lib/auto/Encode/Locale/.packlist | 2 +- .../tlperl/site/lib/auto/Encode/compat/.packlist | 8 +- .../tlperl/site/lib/auto/ExtUtils/Config/.packlist | 1 + .../site/lib/auto/ExtUtils/Helpers/.packlist | 4 + .../site/lib/auto/ExtUtils/InstallPaths/.packlist | 1 + .../tlperl/site/lib/auto/File/Listing/.packlist | 2 +- .../tlperl/site/lib/auto/File/Which/.packlist | 2 +- .../tlperl/site/lib/auto/HTML/Parser/.packlist | 19 +- .../tlperl/site/lib/auto/HTML/Parser/Parser.dll | Bin 51200 -> 41472 bytes .../tlperl/site/lib/auto/HTML/Parser/Parser.exp | Bin 0 -> 902 bytes .../tlperl/site/lib/auto/HTML/Parser/Parser.lib | Bin 0 -> 1736 bytes .../tlperl/site/lib/auto/HTML/Parser/Parser.pdb | Bin 0 -> 643072 bytes .../tlperl/site/lib/auto/HTML/Tagset/.packlist | 2 +- .../tlperl/site/lib/auto/HTTP/Cookies/.packlist | 6 +- .../tlperl/site/lib/auto/HTTP/Daemon/.packlist | 2 +- .../tlpkg/tlperl/site/lib/auto/HTTP/Date/.packlist | 2 +- .../tlperl/site/lib/auto/HTTP/Message/.packlist | 20 +- .../tlperl/site/lib/auto/HTTP/Negotiate/.packlist | 2 +- .../tlpkg/tlperl/site/lib/auto/IO/HTML/.packlist | 2 +- .../tlpkg/tlperl/site/lib/auto/IO/String/.packlist | 2 +- .../tlperl/site/lib/auto/JSON/MaybeXS/.packlist | 2 +- .../tlperl/site/lib/auto/LWP/MediaTypes/.packlist | 4 +- .../tlperl/site/lib/auto/Math/Int64/.packlist | 13 +- .../tlperl/site/lib/auto/Math/Int64/Int64.dll | Bin 61440 -> 51712 bytes .../tlperl/site/lib/auto/Math/Int64/Int64.exp | Bin 0 -> 893 bytes .../tlperl/site/lib/auto/Math/Int64/Int64.lib | Bin 0 -> 1718 bytes .../tlperl/site/lib/auto/Math/Int64/Int64.pdb | Bin 0 -> 675840 bytes .../site/lib/auto/Module/Build/Tiny/.packlist | 1 + .../tlperl/site/lib/auto/Mozilla/CA/.packlist | 5 +- .../tlpkg/tlperl/site/lib/auto/Net/HTTP/.packlist | 8 +- .../tlpkg/tlperl/site/lib/auto/Socket/.packlist | 5 + .../tlpkg/tlperl/site/lib/auto/Socket/Socket.dll | Bin 0 -> 35840 bytes .../tlpkg/tlperl/site/lib/auto/Socket/Socket.exp | Bin 0 -> 870 bytes .../tlpkg/tlperl/site/lib/auto/Socket/Socket.lib | Bin 0 -> 1706 bytes .../tlpkg/tlperl/site/lib/auto/Socket/Socket.pdb | Bin 0 -> 618496 bytes .../tlperl/site/lib/auto/Test/Fatal/.packlist | 2 +- .../tlperl/site/lib/auto/Test/Harness/.packlist | 52 + .../tlperl/site/lib/auto/Test/Needs/.packlist | 2 +- .../site/lib/auto/Test/RequiresInternet/.packlist | 2 +- .../tlperl/site/lib/auto/Test/Warnings/.packlist | 1 + .../tlpkg/tlperl/site/lib/auto/Try/Tiny/.packlist | 2 +- .../tlnet/tlpkg/tlperl/site/lib/auto/URI/.packlist | 111 +- .../tlperl/site/lib/auto/WWW/RobotRules/.packlist | 4 +- .../tlpkg/tlperl/site/lib/auto/Win32/API/.packlist | 20 +- .../tlpkg/tlperl/site/lib/auto/Win32/API/API.dll | Bin 30720 -> 17920 bytes .../tlpkg/tlperl/site/lib/auto/Win32/API/API.exp | Bin 0 -> 879 bytes .../tlpkg/tlperl/site/lib/auto/Win32/API/API.lib | Bin 0 -> 1688 bytes .../tlpkg/tlperl/site/lib/auto/Win32/API/API.pdb | Bin 0 -> 331776 bytes .../site/lib/auto/Win32/API/Callback/Callback.dll | Bin 47616 -> 14848 bytes .../site/lib/auto/Win32/API/Callback/Callback.exp | Bin 0 -> 959 bytes .../site/lib/auto/Win32/API/Callback/Callback.lib | Bin 0 -> 1800 bytes .../site/lib/auto/Win32/API/Callback/Callback.pdb | Bin 0 -> 315392 bytes .../tlperl/site/lib/auto/Win32/Console/.packlist | 7 +- .../tlperl/site/lib/auto/Win32/Console/Console.dll | Bin 70144 -> 42496 bytes .../tlperl/site/lib/auto/Win32/Console/Console.exp | Bin 0 -> 919 bytes .../tlperl/site/lib/auto/Win32/Console/Console.lib | Bin 0 -> 1756 bytes .../tlperl/site/lib/auto/Win32/Console/Console.pdb | Bin 0 -> 675840 bytes .../tlperl/site/lib/auto/Win32/Shortcut/.packlist | 7 +- .../site/lib/auto/Win32/Shortcut/Shortcut.dll | Bin 53248 -> 23040 bytes .../site/lib/auto/Win32/Shortcut/Shortcut.exp | Bin 0 -> 928 bytes .../site/lib/auto/Win32/Shortcut/Shortcut.lib | Bin 0 -> 1774 bytes .../site/lib/auto/Win32/Shortcut/Shortcut.pdb | Bin 0 -> 733184 bytes .../site/lib/auto/Win32/TieRegistry/.packlist | 4 +- .../site/lib/auto/Win32API/Registry/.packlist | 9 +- .../site/lib/auto/Win32API/Registry/Registry.dll | Bin 158720 -> 134656 bytes .../site/lib/auto/Win32API/Registry/Registry.exp | Bin 0 -> 946 bytes .../site/lib/auto/Win32API/Registry/Registry.lib | Bin 0 -> 1790 bytes .../site/lib/auto/Win32API/Registry/Registry.pdb | Bin 0 -> 815104 bytes .../tlperl/site/lib/auto/libwww/perl/.packlist | 33 - .../tlnet/tlpkg/tlperl/site/lib/libwww/lwpcook.pod | 310 --- .../tlnet/tlpkg/tlperl/site/lib/libwww/lwptut.pod | 820 -------- 246 files changed, 19974 insertions(+), 9481 deletions(-) create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result/Test.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Config.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Unix.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/VMS.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Windows.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/InstallPaths.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/ConnCache.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug/TraceHTTP.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/DebugFile.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MemberMixin.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/cpan.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/data.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/file.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/ftp.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/gopher.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/http.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/loopback.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/RobotUA.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Simple.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/UserAgent.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/Module/Build/Tiny.pm delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/mk-ca-bundle.pl create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/Socket.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Base.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Base.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Color.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/ParallelSession.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/Session.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File/Session.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Session.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Beyond.pod create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Env.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Aggregator.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Grammar.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Array.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Process.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Stream.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/IteratorFactory.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Multiplexer.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Bailout.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Comment.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Plan.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Pragma.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Test.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Unknown.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Version.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/YAML.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/ResultFactory.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Job.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Spinner.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Source.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Executable.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/File.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Handle.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Perl.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/RawTAP.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Reader.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Writer.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/HACKING.pod create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Harness.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Warnings.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icap.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Config/.packlist create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Helpers/.packlist create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/InstallPaths/.packlist create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Module/Build/Tiny/.packlist create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/.packlist create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.dll create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Harness/.packlist create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Warnings/.packlist create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.pdb create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.exp create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.lib create mode 100755 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.pdb delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/libwww/perl/.packlist delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwpcook.pod delete mode 100644 systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwptut.pod (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site') diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove.pm new file mode 100755 index 0000000000..a7230ddea7 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove.pm @@ -0,0 +1,817 @@ +package App::Prove; + +use strict; +use warnings; + +use TAP::Harness::Env; +use Text::ParseWords qw(shellwords); +use File::Spec; +use Getopt::Long; +use App::Prove::State; +use Carp; + +use base 'TAP::Object'; + +=head1 NAME + +App::Prove - Implements the C command. + +=head1 VERSION + +Version 3.48 + +=cut + +our $VERSION = '3.48'; + +=head1 DESCRIPTION + +L provides a command, C, which runs a TAP based +test suite and prints a report. The C command is a minimal +wrapper around an instance of this module. + +=head1 SYNOPSIS + + use App::Prove; + + my $app = App::Prove->new; + $app->process_args(@ARGV); + $app->run; + +=cut + +use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ ); +use constant IS_VMS => $^O eq 'VMS'; +use constant IS_UNIXY => !( IS_VMS || IS_WIN32 ); + +use constant STATE_FILE => IS_UNIXY ? '.prove' : '_prove'; +use constant RC_FILE => IS_UNIXY ? '.proverc' : '_proverc'; + +use constant PLUGINS => 'App::Prove::Plugin'; + +my @ATTR; + +BEGIN { + @ATTR = qw( + archive argv blib show_count color directives exec failures comments + formatter harness includes modules plugins jobs lib merge parse quiet + really_quiet recurse backwards shuffle taint_fail taint_warn timer + verbose warnings_fail warnings_warn show_help show_man show_version + state_class test_args state dry extensions ignore_exit rules state_manager + normalize sources tapversion trap + statefile + ); + __PACKAGE__->mk_methods(@ATTR); +} + +=head1 METHODS + +=head2 Class Methods + +=head3 C + +Create a new C. Optionally a hash ref of attribute +initializers may be passed. + +=cut + +# new() implementation supplied by TAP::Object + +sub _initialize { + my $self = shift; + my $args = shift || {}; + + my @is_array = qw( + argv rc_opts includes modules state plugins rules sources + ); + + # setup defaults: + for my $key (@is_array) { + $self->{$key} = []; + } + + for my $attr (@ATTR) { + if ( exists $args->{$attr} ) { + + # TODO: Some validation here + $self->{$attr} = $args->{$attr}; + } + } + + $self->state_class('App::Prove::State'); + return $self; +} + +=head3 C + +Getter/setter for the name of the class used for maintaining state. This +class should either subclass from C or provide an identical +interface. + +=head3 C + +Getter/setter for the instance of the C. + +=cut + +=head3 C + + $prove->add_rc_file('myproj/.proverc'); + +Called before C to prepend the contents of an rc file to +the options. + +=cut + +sub add_rc_file { + my ( $self, $rc_file ) = @_; + + local *RC; + open RC, "<$rc_file" or croak "Can't read $rc_file ($!)"; + while ( defined( my $line = ) ) { + push @{ $self->{rc_opts} }, + grep { defined and not /^#/ } + $line =~ m{ ' ([^']*) ' | " ([^"]*) " | (\#.*) | (\S+) }xg; + } + close RC; +} + +=head3 C + + $prove->process_args(@args); + +Processes the command-line arguments. Attributes will be set +appropriately. Any filenames may be found in the C attribute. + +Dies on invalid arguments. + +=cut + +sub process_args { + my $self = shift; + + my @rc = RC_FILE; + unshift @rc, glob '~/' . RC_FILE if IS_UNIXY; + + # Preprocess meta-args. + my @args; + while ( defined( my $arg = shift ) ) { + if ( $arg eq '--norc' ) { + @rc = (); + } + elsif ( $arg eq '--rc' ) { + defined( my $rc = shift ) + or croak "Missing argument to --rc"; + push @rc, $rc; + } + elsif ( $arg =~ m{^--rc=(.+)$} ) { + push @rc, $1; + } + else { + push @args, $arg; + } + } + + # Everything after the arisdottle '::' gets passed as args to + # test programs. + if ( defined( my $stop_at = _first_pos( '::', @args ) ) ) { + my @test_args = splice @args, $stop_at; + shift @test_args; + $self->{test_args} = \@test_args; + } + + # Grab options from RC files + $self->add_rc_file($_) for grep -f, @rc; + unshift @args, @{ $self->{rc_opts} }; + + if ( my @bad = map {"-$_"} grep {/^-(man|help)$/} @args ) { + die "Long options should be written with two dashes: ", + join( ', ', @bad ), "\n"; + } + + # And finally... + + { + local @ARGV = @args; + Getopt::Long::Configure(qw(no_ignore_case bundling pass_through)); + + # Don't add coderefs to GetOptions + GetOptions( + 'v|verbose' => \$self->{verbose}, + 'f|failures' => \$self->{failures}, + 'o|comments' => \$self->{comments}, + 'l|lib' => \$self->{lib}, + 'b|blib' => \$self->{blib}, + 's|shuffle' => \$self->{shuffle}, + 'color!' => \$self->{color}, + 'colour!' => \$self->{color}, + 'count!' => \$self->{show_count}, + 'c' => \$self->{color}, + 'D|dry' => \$self->{dry}, + 'ext=s@' => sub { + my ( $opt, $val ) = @_; + + # Workaround for Getopt::Long 2.25 handling of + # multivalue options + push @{ $self->{extensions} ||= [] }, $val; + }, + 'harness=s' => \$self->{harness}, + 'ignore-exit' => \$self->{ignore_exit}, + 'source=s@' => $self->{sources}, + 'formatter=s' => \$self->{formatter}, + 'r|recurse' => \$self->{recurse}, + 'reverse' => \$self->{backwards}, + 'p|parse' => \$self->{parse}, + 'q|quiet' => \$self->{quiet}, + 'Q|QUIET' => \$self->{really_quiet}, + 'e|exec=s' => \$self->{exec}, + 'm|merge' => \$self->{merge}, + 'I=s@' => $self->{includes}, + 'M=s@' => $self->{modules}, + 'P=s@' => $self->{plugins}, + 'state=s@' => $self->{state}, + 'statefile=s' => \$self->{statefile}, + 'directives' => \$self->{directives}, + 'h|help|?' => \$self->{show_help}, + 'H|man' => \$self->{show_man}, + 'V|version' => \$self->{show_version}, + 'a|archive=s' => \$self->{archive}, + 'j|jobs=i' => \$self->{jobs}, + 'timer' => \$self->{timer}, + 'T' => \$self->{taint_fail}, + 't' => \$self->{taint_warn}, + 'W' => \$self->{warnings_fail}, + 'w' => \$self->{warnings_warn}, + 'normalize' => \$self->{normalize}, + 'rules=s@' => $self->{rules}, + 'tapversion=s' => \$self->{tapversion}, + 'trap' => \$self->{trap}, + ) or croak('Unable to continue'); + + # Stash the remainder of argv for later + $self->{argv} = [@ARGV]; + } + + return; +} + +sub _first_pos { + my $want = shift; + for ( 0 .. $#_ ) { + return $_ if $_[$_] eq $want; + } + return; +} + +sub _help { + my ( $self, $verbosity ) = @_; + + eval('use Pod::Usage 1.12 ()'); + if ( my $err = $@ ) { + die 'Please install Pod::Usage for the --help option ' + . '(or try `perldoc prove`.)' + . "\n ($@)"; + } + + Pod::Usage::pod2usage( { -verbose => $verbosity } ); + + return; +} + +sub _color_default { + my $self = shift; + + return -t STDOUT && !$ENV{HARNESS_NOTTY}; +} + +sub _get_args { + my $self = shift; + + my %args; + + $args{trap} = 1 if $self->trap; + + if ( defined $self->color ? $self->color : $self->_color_default ) { + $args{color} = 1; + } + if ( !defined $self->show_count ) { + $args{show_count} = 1; + } + else { + $args{show_count} = $self->show_count; + } + + if ( $self->archive ) { + $self->require_harness( archive => 'TAP::Harness::Archive' ); + $args{archive} = $self->archive; + } + + if ( my $jobs = $self->jobs ) { + $args{jobs} = $jobs; + } + + if ( my $harness_opt = $self->harness ) { + $self->require_harness( harness => $harness_opt ); + } + + if ( my $formatter = $self->formatter ) { + $args{formatter_class} = $formatter; + } + + for my $handler ( @{ $self->sources } ) { + my ( $name, $config ) = $self->_parse_source($handler); + $args{sources}->{$name} = $config; + } + + if ( $self->ignore_exit ) { + $args{ignore_exit} = 1; + } + + if ( $self->taint_fail && $self->taint_warn ) { + die '-t and -T are mutually exclusive'; + } + + if ( $self->warnings_fail && $self->warnings_warn ) { + die '-w and -W are mutually exclusive'; + } + + for my $a (qw( lib switches )) { + my $method = "_get_$a"; + my $val = $self->$method(); + $args{$a} = $val if defined $val; + } + + # Handle verbose, quiet, really_quiet flags + my %verb_map = ( verbose => 1, quiet => -1, really_quiet => -2, ); + + my @verb_adj = map { $self->$_() ? $verb_map{$_} : () } + keys %verb_map; + + die "Only one of verbose, quiet or really_quiet should be specified\n" + if @verb_adj > 1; + + $args{verbosity} = shift @verb_adj if @verb_adj; + + for my $a (qw( merge failures comments timer directives normalize )) { + $args{$a} = 1 if $self->$a(); + } + + $args{errors} = 1 if $self->parse; + + # defined but zero-length exec runs test files as binaries + $args{exec} = [ split( /\s+/, $self->exec ) ] + if ( defined( $self->exec ) ); + + $args{version} = $self->tapversion if defined( $self->tapversion ); + + if ( defined( my $test_args = $self->test_args ) ) { + $args{test_args} = $test_args; + } + + if ( @{ $self->rules } ) { + my @rules; + for ( @{ $self->rules } ) { + if (/^par=(.*)/) { + push @rules, $1; + } + elsif (/^seq=(.*)/) { + push @rules, { seq => $1 }; + } + } + $args{rules} = { par => [@rules] }; + } + $args{harness_class} = $self->{harness_class} if $self->{harness_class}; + + return \%args; +} + +sub _find_module { + my ( $self, $class, @search ) = @_; + + croak "Bad module name $class" + unless $class =~ /^ \w+ (?: :: \w+ ) *$/x; + + for my $pfx (@search) { + my $name = join( '::', $pfx, $class ); + eval "require $name"; + return $name unless $@; + } + + eval "require $class"; + return $class unless $@; + return; +} + +sub _load_extension { + my ( $self, $name, @search ) = @_; + + my @args = (); + if ( $name =~ /^(.*?)=(.*)/ ) { + $name = $1; + @args = split( /,/, $2 ); + } + + if ( my $class = $self->_find_module( $name, @search ) ) { + if ( $class->can('load') ) { + $class->load( { app_prove => $self, args => [@args] } ); + } + } + else { + croak "Can't load module $name"; + } +} + +sub _load_extensions { + my ( $self, $ext, @search ) = @_; + $self->_load_extension( $_, @search ) for @$ext; +} + +sub _parse_source { + my ( $self, $handler ) = @_; + + # Load any options. + ( my $opt_name = lc $handler ) =~ s/::/-/g; + local @ARGV = @{ $self->{argv} }; + my %config; + Getopt::Long::GetOptions( + "$opt_name-option=s%" => sub { + my ( $name, $k, $v ) = @_; + if ( $v =~ /(? $v; + } + else { + $config{$k} = $v; + } + } + } + ); + $self->{argv} = \@ARGV; + return ( $handler, \%config ); +} + +=head3 C + +Perform whatever actions the command line args specified. The C +command line tool consists of the following code: + + use App::Prove; + + my $app = App::Prove->new; + $app->process_args(@ARGV); + exit( $app->run ? 0 : 1 ); # if you need the exit code + +=cut + +sub run { + my $self = shift; + + unless ( $self->state_manager ) { + $self->state_manager( + $self->state_class->new( { store => $self->statefile || STATE_FILE } ) ); + } + + if ( $self->show_help ) { + $self->_help(1); + } + elsif ( $self->show_man ) { + $self->_help(2); + } + elsif ( $self->show_version ) { + $self->print_version; + } + elsif ( $self->dry ) { + print "$_\n" for $self->_get_tests; + } + else { + + $self->_load_extensions( $self->modules ); + $self->_load_extensions( $self->plugins, PLUGINS ); + + local $ENV{TEST_VERBOSE} = 1 if $self->verbose; + + return $self->_runtests( $self->_get_args, $self->_get_tests ); + } + + return 1; +} + +sub _get_tests { + my $self = shift; + + my $state = $self->state_manager; + my $ext = $self->extensions; + $state->extensions($ext) if defined $ext; + if ( defined( my $state_switch = $self->state ) ) { + $state->apply_switch(@$state_switch); + } + + my @tests = $state->get_tests( $self->recurse, @{ $self->argv } ); + + $self->_shuffle(@tests) if $self->shuffle; + @tests = reverse @tests if $self->backwards; + + return @tests; +} + +sub _runtests { + my ( $self, $args, @tests ) = @_; + my $harness = TAP::Harness::Env->create($args); + + my $state = $self->state_manager; + + $harness->callback( + after_test => sub { + $state->observe_test(@_); + } + ); + + $harness->callback( + after_runtests => sub { + $state->commit(@_); + } + ); + + my $aggregator = $harness->runtests(@tests); + + return !$aggregator->has_errors; +} + +sub _get_switches { + my $self = shift; + my @switches; + + # notes that -T or -t must be at the front of the switches! + if ( $self->taint_fail ) { + push @switches, '-T'; + } + elsif ( $self->taint_warn ) { + push @switches, '-t'; + } + if ( $self->warnings_fail ) { + push @switches, '-W'; + } + elsif ( $self->warnings_warn ) { + push @switches, '-w'; + } + + return @switches ? \@switches : (); +} + +sub _get_lib { + my $self = shift; + my @libs; + if ( $self->lib ) { + push @libs, 'lib'; + } + if ( $self->blib ) { + push @libs, 'blib/lib', 'blib/arch'; + } + if ( @{ $self->includes } ) { + push @libs, @{ $self->includes }; + } + + #24926 + @libs = map { File::Spec->rel2abs($_) } @libs; + + # Huh? + return @libs ? \@libs : (); +} + +sub _shuffle { + my $self = shift; + + # Fisher-Yates shuffle + my $i = @_; + while ($i) { + my $j = rand $i--; + @_[ $i, $j ] = @_[ $j, $i ]; + } + return; +} + +=head3 C + +Load a harness replacement class. + + $prove->require_harness($for => $class_name); + +=cut + +sub require_harness { + my ( $self, $for, $class ) = @_; + + my ($class_name) = $class =~ /^(\w+(?:::\w+)*)/; + + # Emulate Perl's -MModule=arg1,arg2 behaviour + $class =~ s!^(\w+(?:::\w+)*)=(.*)$!$1 split(/,/,q{$2})!; + + eval("use $class;"); + die "$class_name is required to use the --$for feature: $@" if $@; + + $self->{harness_class} = $class_name; + + return; +} + +=head3 C + +Display the version numbers of the loaded L and the +current Perl. + +=cut + +sub print_version { + my $self = shift; + require TAP::Harness; + printf( + "TAP::Harness v%s and Perl v%vd\n", + $TAP::Harness::VERSION, $^V + ); + + return; +} + +1; + +# vim:ts=4:sw=4:et:sta + +__END__ + +=head2 Attributes + +After command line parsing the following attributes reflect the values +of the corresponding command line switches. They may be altered before +calling C. + +=over + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=item C + +=back + +=head1 PLUGINS + +C provides support for 3rd-party plugins. These are currently +loaded at run-time, I arguments have been parsed (so you can not +change the way arguments are processed, sorry), typically with the +C<< -PI >> switch, eg: + + prove -PMyPlugin + +This will search for a module named C, or failing +that, C. If the plugin can't be found, C will complain & exit. + +You can pass an argument to your plugin by appending an C<=> after the plugin +name, eg C<-PMyPlugin=foo>. You can pass multiple arguments using commas: + + prove -PMyPlugin=foo,bar,baz + +These are passed in to your plugin's C class method (if it has one), +along with a reference to the C object that is invoking your plugin: + + sub load { + my ($class, $p) = @_; + + my @args = @{ $p->{args} }; + # @args will contain ( 'foo', 'bar', 'baz' ) + $p->{app_prove}->do_something; + ... + } + +=head2 Sample Plugin + +Here's a sample plugin, for your reference: + + package App::Prove::Plugin::Foo; + + # Sample plugin, try running with: + # prove -PFoo=bar -r -j3 + # prove -PFoo -Q + # prove -PFoo=bar,My::Formatter + + use strict; + use warnings; + + sub load { + my ($class, $p) = @_; + my @args = @{ $p->{args} }; + my $app = $p->{app_prove}; + + print "loading plugin: $class, args: ", join(', ', @args ), "\n"; + + # turn on verbosity + $app->verbose( 1 ); + + # set the formatter? + $app->formatter( $args[1] ) if @args > 1; + + # print some of App::Prove's state: + for my $attr (qw( jobs quiet really_quiet recurse verbose )) { + my $val = $app->$attr; + $val = 'undef' unless defined( $val ); + print "$attr: $val\n"; + } + + return 1; + } + + 1; + +=head1 SEE ALSO + +L, L + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State.pm new file mode 100755 index 0000000000..d4477e2b25 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State.pm @@ -0,0 +1,548 @@ +package App::Prove::State; + +use strict; +use warnings; + +use File::Find; +use File::Spec; +use Carp; + +use App::Prove::State::Result; +use TAP::Parser::YAMLish::Reader (); +use TAP::Parser::YAMLish::Writer (); +use base 'TAP::Base'; + +BEGIN { + __PACKAGE__->mk_methods('result_class'); +} + +use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ ); +use constant NEED_GLOB => IS_WIN32; + +=head1 NAME + +App::Prove::State - State storage for the C command. + +=head1 VERSION + +Version 3.48 + +=cut + +our $VERSION = '3.48'; + +=head1 DESCRIPTION + +The C command supports a C<--state> option that instructs it to +store persistent state across runs. This module implements that state +and the operations that may be performed on it. + +=head1 SYNOPSIS + + # Re-run failed tests + $ prove --state=failed,save -rbv + +=cut + +=head1 METHODS + +=head2 Class Methods + +=head3 C + +Accepts a hashref with the following key/value pairs: + +=over 4 + +=item * C + +The filename of the data store holding the data that App::Prove::State reads. + +=item * C (optional) + +The test name extensions. Defaults to C<.t>. + +=item * C (optional) + +The name of the C. Defaults to C. + +=back + +=cut + +# override TAP::Base::new: +sub new { + my $class = shift; + my %args = %{ shift || {} }; + + my $self = bless { + select => [], + seq => 1, + store => delete $args{store}, + extensions => ( delete $args{extensions} || ['.t'] ), + result_class => + ( delete $args{result_class} || 'App::Prove::State::Result' ), + }, $class; + + $self->{_} = $self->result_class->new( + { tests => {}, + generation => 1, + } + ); + my $store = $self->{store}; + $self->load($store) + if defined $store && -f $store; + + return $self; +} + +=head2 C + +Getter/setter for the name of the class used for tracking test results. This +class should either subclass from C or provide an +identical interface. + +=cut + +=head2 C + +Get or set the list of extensions that files must have in order to be +considered tests. Defaults to ['.t']. + +=cut + +sub extensions { + my $self = shift; + $self->{extensions} = shift if @_; + return $self->{extensions}; +} + +=head2 C + +Get the results of the last test run. Returns a C instance. + +=cut + +sub results { + my $self = shift; + $self->{_} || $self->result_class->new; +} + +=head2 C + +Save the test results. Should be called after all tests have run. + +=cut + +sub commit { + my $self = shift; + if ( $self->{should_save} ) { + $self->save; + } +} + +=head2 Instance Methods + +=head3 C + + $self->apply_switch('failed,save'); + +Apply a list of switch options to the state, updating the internal +object state as a result. Nothing is returned. + +Diagnostics: + - "Illegal state option: %s" + +=over + +=item C + +Run in the same order as last time + +=item C + +Run only the failed tests from last time + +=item C + +Run only the passed tests from last time + +=item C + +Run all tests in normal order + +=item C + +Run the tests that most recently failed first + +=item C + +Run the tests ordered by number of todos. + +=item C + +Run the tests in slowest to fastest order. + +=item C + +Run test tests in fastest to slowest order. + +=item C + +Run the tests in newest to oldest order. + +=item C + +Run the tests in oldest to newest order. + +=item C + +Save the state on exit. + +=back + +=cut + +sub apply_switch { + my $self = shift; + my @opts = @_; + + my $last_gen = $self->results->generation - 1; + my $last_run_time = $self->results->last_run_time; + my $now = $self->get_time; + + my @switches = map { split /,/ } @opts; + + my %handler = ( + last => sub { + $self->_select( + limit => shift, + where => sub { $_->generation >= $last_gen }, + order => sub { $_->sequence } + ); + }, + failed => sub { + $self->_select( + limit => shift, + where => sub { $_->result != 0 }, + order => sub { -$_->result } + ); + }, + passed => sub { + $self->_select( + limit => shift, + where => sub { $_->result == 0 } + ); + }, + all => sub { + $self->_select( limit => shift ); + }, + todo => sub { + $self->_select( + limit => shift, + where => sub { $_->num_todo != 0 }, + order => sub { -$_->num_todo; } + ); + }, + hot => sub { + $self->_select( + limit => shift, + where => sub { defined $_->last_fail_time }, + order => sub { $now - $_->last_fail_time } + ); + }, + slow => sub { + $self->_select( + limit => shift, + order => sub { -$_->elapsed } + ); + }, + fast => sub { + $self->_select( + limit => shift, + order => sub { $_->elapsed } + ); + }, + new => sub { + $self->_select( + limit => shift, + order => sub { -$_->mtime } + ); + }, + old => sub { + $self->_select( + limit => shift, + order => sub { $_->mtime } + ); + }, + fresh => sub { + $self->_select( + limit => shift, + where => sub { $_->mtime >= $last_run_time } + ); + }, + save => sub { + $self->{should_save}++; + }, + adrian => sub { + unshift @switches, qw( hot all save ); + }, + ); + + while ( defined( my $ele = shift @switches ) ) { + my ( $opt, $arg ) + = ( $ele =~ /^([^:]+):(.*)/ ) + ? ( $1, $2 ) + : ( $ele, undef ); + my $code = $handler{$opt} + || croak "Illegal state option: $opt"; + $code->($arg); + } + return; +} + +sub _select { + my ( $self, %spec ) = @_; + push @{ $self->{select} }, \%spec; +} + +=head3 C + +Given a list of args get the names of tests that should run + +=cut + +sub get_tests { + my $self = shift; + my $recurse = shift; + my @argv = @_; + my %seen; + + my @selected = $self->_query; + + unless ( @argv || @{ $self->{select} } ) { + @argv = $recurse ? '.' : 't'; + croak qq{No tests named and '@argv' directory not found} + unless -d $argv[0]; + } + + push @selected, $self->_get_raw_tests( $recurse, @argv ) if @argv; + return grep { !$seen{$_}++ } @selected; +} + +sub _query { + my $self = shift; + if ( my @sel = @{ $self->{select} } ) { + warn "No saved state, selection will be empty\n" + unless $self->results->num_tests; + return map { $self->_query_clause($_) } @sel; + } + return; +} + +sub _query_clause { + my ( $self, $clause ) = @_; + my @got; + my $results = $self->results; + my $where = $clause->{where} || sub {1}; + + # Select + for my $name ( $results->test_names ) { + next unless -f $name; + local $_ = $results->test($name); + push @got, $name if $where->(); + } + + # Sort + if ( my $order = $clause->{order} ) { + @got = map { $_->[0] } + sort { + ( defined $b->[1] <=> defined $a->[1] ) + || ( ( $a->[1] || 0 ) <=> ( $b->[1] || 0 ) ) + } map { + [ $_, + do { local $_ = $results->test($_); $order->() } + ] + } @got; + } + + if ( my $limit = $clause->{limit} ) { + @got = splice @got, 0, $limit if @got > $limit; + } + + return @got; +} + +sub _get_raw_tests { + my $self = shift; + my $recurse = shift; + my @argv = @_; + my @tests; + + # Do globbing on Win32. + if (NEED_GLOB) { + eval "use File::Glob::Windows"; # [49732] + @argv = map { glob "$_" } @argv; + } + my $extensions = $self->{extensions}; + + for my $arg (@argv) { + if ( '-' eq $arg ) { + push @argv => ; + chomp(@argv); + next; + } + + push @tests, + sort -d $arg + ? $recurse + ? $self->_expand_dir_recursive( $arg, $extensions ) + : map { glob( File::Spec->catfile( $arg, "*$_" ) ) } + @{$extensions} + : $arg; + } + return @tests; +} + +sub _expand_dir_recursive { + my ( $self, $dir, $extensions ) = @_; + + my @tests; + my $ext_string = join( '|', map {quotemeta} @{$extensions} ); + + find( + { follow => 1, #21938 + follow_skip => 2, + wanted => sub { + -f + && /(?:$ext_string)$/ + && push @tests => $File::Find::name; + } + }, + $dir + ); + return @tests; +} + +=head3 C + +Store the results of a test. + +=cut + +# Store: +# last fail time +# last pass time +# last run time +# most recent result +# most recent todos +# total failures +# total passes +# state generation +# parser + +sub observe_test { + + my ( $self, $test_info, $parser ) = @_; + my $name = $test_info->[0]; + my $fail = scalar( $parser->failed ) + ( $parser->has_problems ? 1 : 0 ); + my $todo = scalar( $parser->todo ); + my $start_time = $parser->start_time; + my $end_time = $parser->end_time, + + my $test = $self->results->test($name); + + $test->sequence( $self->{seq}++ ); + $test->generation( $self->results->generation ); + + $test->run_time($end_time); + $test->result($fail); + $test->num_todo($todo); + $test->elapsed( $end_time - $start_time ); + + $test->parser($parser); + + if ($fail) { + $test->total_failures( $test->total_failures + 1 ); + $test->last_fail_time($end_time); + } + else { + $test->total_passes( $test->total_passes + 1 ); + $test->last_pass_time($end_time); + } +} + +=head3 C + +Write the state to a file. + +=cut + +sub save { + my ($self) = @_; + + my $store = $self->{store} or return; + $self->results->last_run_time( $self->get_time ); + + my $writer = TAP::Parser::YAMLish::Writer->new; + local *FH; + open FH, ">$store" or croak "Can't write $store ($!)"; + $writer->write( $self->results->raw, \*FH ); + close FH; +} + +=head3 C + +Load the state from a file + +=cut + +sub load { + my ( $self, $name ) = @_; + my $reader = TAP::Parser::YAMLish::Reader->new; + local *FH; + open FH, "<$name" or croak "Can't read $name ($!)"; + + # XXX this is temporary + $self->{_} = $self->result_class->new( + $reader->read( + sub { + my $line = ; + defined $line && chomp $line; + return $line; + } + ) + ); + + # $writer->write( $self->{tests} || {}, \*FH ); + close FH; + $self->_regen_seq; + $self->_prune_and_stamp; + $self->results->generation( $self->results->generation + 1 ); +} + +sub _prune_and_stamp { + my $self = shift; + + my $results = $self->results; + my @tests = $self->results->tests; + for my $test (@tests) { + my $name = $test->name; + if ( my @stat = stat $name ) { + $test->mtime( $stat[9] ); + } + else { + $results->remove($name); + } + } +} + +sub _regen_seq { + my $self = shift; + for my $test ( $self->results->tests ) { + $self->{seq} = $test->sequence + 1 + if defined $test->sequence && $test->sequence >= $self->{seq}; + } +} + +1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result.pm new file mode 100755 index 0000000000..38faf6f24d --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result.pm @@ -0,0 +1,233 @@ +package App::Prove::State::Result; + +use strict; +use warnings; +use Carp 'croak'; + +use App::Prove::State::Result::Test; + +use constant STATE_VERSION => 1; + +=head1 NAME + +App::Prove::State::Result - Individual test suite results. + +=head1 VERSION + +Version 3.48 + +=cut + +our $VERSION = '3.48'; + +=head1 DESCRIPTION + +The C command supports a C<--state> option that instructs it to +store persistent state across runs. This module encapsulates the results for a +single test suite run. + +=head1 SYNOPSIS + + # Re-run failed tests + $ prove --state=failed,save -rbv + +=cut + +=head1 METHODS + +=head2 Class Methods + +=head3 C + + my $result = App::Prove::State::Result->new({ + generation => $generation, + tests => \%tests, + }); + +Returns a new C instance. + +=cut + +sub new { + my ( $class, $arg_for ) = @_; + $arg_for ||= {}; + my %instance_data = %$arg_for; # shallow copy + $instance_data{version} = $class->state_version; + my $tests = delete $instance_data{tests} || {}; + my $self = bless \%instance_data => $class; + $self->_initialize($tests); + return $self; +} + +sub _initialize { + my ( $self, $tests ) = @_; + my %tests; + while ( my ( $name, $test ) = each %$tests ) { + $tests{$name} = $self->test_class->new( + { %$test, + name => $name + } + ); + } + $self->tests( \%tests ); + return $self; +} + +=head2 C + +Returns the current version of state storage. + +=cut + +sub state_version {STATE_VERSION} + +=head2 C + +Returns the name of the class used for tracking individual tests. This class +should either subclass from C or provide an +identical interface. + +=cut + +sub test_class { + return 'App::Prove::State::Result::Test'; +} + +my %methods = ( + generation => { method => 'generation', default => 0 }, + last_run_time => { method => 'last_run_time', default => undef }, +); + +while ( my ( $key, $description ) = each %methods ) { + my $default = $description->{default}; + no strict 'refs'; + *{ $description->{method} } = sub { + my $self = shift; + if (@_) { + $self->{$key} = shift; + return $self; + } + return $self->{$key} || $default; + }; +} + +=head3 C + +Getter/setter for the "generation" of the test suite run. The first +generation is 1 (one) and subsequent generations are 2, 3, etc. + +=head3 C + +Getter/setter for the time of the test suite run. + +=head3 C + +Returns the tests for a given generation. This is a hashref or a hash, +depending on context called. The keys to the hash are the individual +test names and the value is a hashref with various interesting values. +Each k/v pair might resemble something like this: + + 't/foo.t' => { + elapsed => '0.0428488254547119', + gen => '7', + last_pass_time => '1219328376.07815', + last_result => '0', + last_run_time => '1219328376.07815', + last_todo => '0', + mtime => '1191708862', + seq => '192', + total_passes => '6', + } + +=cut + +sub tests { + my $self = shift; + if (@_) { + $self->{tests} = shift; + return $self; + } + my %tests = %{ $self->{tests} }; + my @tests = sort { $a->sequence <=> $b->sequence } values %tests; + return wantarray ? @tests : \@tests; +} + +=head3 C + + my $test = $result->test('t/customer/create.t'); + +Returns an individual C instance for the +given test name (usually the filename). Will return a new +C instance if the name is not found. + +=cut + +sub test { + my ( $self, $name ) = @_; + croak("test() requires a test name") unless defined $name; + + my $tests = $self->{tests} ||= {}; + if ( my $test = $tests->{$name} ) { + return $test; + } + else { + my $test = $self->test_class->new( { name => $name } ); + $self->{tests}->{$name} = $test; + return $test; + } +} + +=head3 C + +Returns an list of test names, sorted by run order. + +=cut + +sub test_names { + my $self = shift; + return map { $_->name } $self->tests; +} + +=head3 C + + $result->remove($test_name); # remove the test + my $test = $result->test($test_name); # fatal error + +Removes a given test from results. This is a no-op if the test name is not +found. + +=cut + +sub remove { + my ( $self, $name ) = @_; + delete $self->{tests}->{$name}; + return $self; +} + +=head3 C + +Returns the number of tests for a given test suite result. + +=cut + +sub num_tests { keys %{ shift->{tests} } } + +=head3 C + +Returns a hashref of raw results, suitable for serialization by YAML. + +=cut + +sub raw { + my $self = shift; + my %raw = %$self; + + my %tests; + for my $test ( $self->tests ) { + $tests{ $test->name } = $test->raw; + } + $raw{tests} = \%tests; + return \%raw; +} + +1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result/Test.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result/Test.pm new file mode 100755 index 0000000000..61a5173cfa --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result/Test.pm @@ -0,0 +1,152 @@ +package App::Prove::State::Result::Test; + +use strict; +use warnings; + +=head1 NAME + +App::Prove::State::Result::Test - Individual test results. + +=head1 VERSION + +Version 3.48 + +=cut + +our $VERSION = '3.48'; + +=head1 DESCRIPTION + +The C command supports a C<--state> option that instructs it to +store persistent state across runs. This module encapsulates the results for a +single test. + +=head1 SYNOPSIS + + # Re-run failed tests + $ prove --state=failed,save -rbv + +=cut + +my %methods = ( + name => { method => 'name' }, + elapsed => { method => 'elapsed', default => 0 }, + gen => { method => 'generation', default => 1 }, + last_pass_time => { method => 'last_pass_time', default => undef }, + last_fail_time => { method => 'last_fail_time', default => undef }, + last_result => { method => 'result', default => 0 }, + last_run_time => { method => 'run_time', default => undef }, + last_todo => { method => 'num_todo', default => 0 }, + mtime => { method => 'mtime', default => undef }, + seq => { method => 'sequence', default => 1 }, + total_passes => { method => 'total_passes', default => 0 }, + total_failures => { method => 'total_failures', default => 0 }, + parser => { method => 'parser' }, +); + +while ( my ( $key, $description ) = each %methods ) { + my $default = $description->{default}; + no strict 'refs'; + *{ $description->{method} } = sub { + my $self = shift; + if (@_) { + $self->{$key} = shift; + return $self; + } + return $self->{$key} || $default; + }; +} + +=head1 METHODS + +=head2 Class Methods + +=head3 C + +=cut + +sub new { + my ( $class, $arg_for ) = @_; + $arg_for ||= {}; + bless $arg_for => $class; +} + +=head2 Instance Methods + +=head3 C + +The name of the test. Usually a filename. + +=head3 C + +The total elapsed times the test took to run, in seconds from the epoch.. + +=head3 C + +The number for the "generation" of the test run. The first generation is 1 +(one) and subsequent generations are 2, 3, etc. + +=head3 C + +The last time the test program passed, in seconds from the epoch. + +Returns C if the program has never passed. + +=head3 C + +The last time the test suite failed, in seconds from the epoch. + +Returns C if the program has never failed. + +=head3 C + +Returns the mtime of the test, in seconds from the epoch. + +=head3 C + +Returns a hashref of raw test data, suitable for serialization by YAML. + +=head3 C + +Currently, whether or not the test suite passed with no 'problems' (such as +TODO passed). + +=head3 C + +The total time it took for the test to run, in seconds. If C is +available, it will have finer granularity. + +=head3 C + +The number of tests with TODO directives. + +=head3 C + +The order in which this test was run for the given test suite result. + +=head3 C + +The number of times the test has passed. + +=head3 C + +The number of times the test has failed. + +=head3 C + +The underlying parser object. This is useful if you need the full +information for the test program. + +=cut + +sub raw { + my $self = shift; + my %raw = %$self; + + # this is backwards-compatibility hack and is not guaranteed. + delete $raw{name}; + delete $raw{parser}; + return \%raw; +} + +1; diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS.pm index 49f15fcee2..887285846f 100755 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS.pm @@ -1,5 +1,5 @@ package Cpanel::JSON::XS; -our $VERSION = '4.27'; +our $VERSION = '4.37'; our $XS_VERSION = $VERSION; # $VERSION = eval $VERSION; @@ -112,7 +112,10 @@ or L B +- bare hashkeys are now checked for utf8. (GH #209) + - stricter decode_json() as documented. non-refs are disallowed. + safe by default. added a 2nd optional argument. decode() honors now allow_nonref. - fixed encode of numbers for dual-vars. Different string @@ -157,8 +160,14 @@ B - relaxed mode, allowing many popular extensions +- protect our magic object from corruption by wrong or missing external + methods, like FREEZE/THAW or serialization with other methods. + - additional fixes for: + - #208 - no security-relevant out-of-bounds reading of module memory + when decoding hash keys without ending ':' + - [cpan #88061] AIX atof without USE_LONG_DOUBLE - #10 unshare_hek crash @@ -180,6 +189,8 @@ B - #167 sort tied hashes with canonical. + - #212 fix utf8 object stringification + - public maintenance and bugtracker - use ppport.h, sanify XS.xs comment styles, harness C coding style @@ -187,15 +198,15 @@ B - common::sense is optional. When available it is not used in the published production module, just during development and testing. -- extended testsuite, passes all http://seriot.ch/parsing_json.html +- extended testsuite, passes all http://seriot.ch/projects/parsing_json.html tests. In fact it is the only know JSON decoder which does so, while also being the fastest. - support many more options and methods from JSON::PP: stringify_infnan, allow_unknown, allow_stringify, allow_barekey, - encode_stringify, allow_bignum, allow_singlequote, sort_by - (partially), escape_slash, convert_blessed, ... optional - decode_json(, allow_nonref) arg. + encode_stringify, allow_bignum, allow_singlequote, dupkeys_as_arrayref, + sort_by (partially), escape_slash, convert_blessed, ... + optional decode_json(, allow_nonref) arg. relaxed implements allow_dupkeys. - support all 5 unicode L's: UTF-8, UTF-16LE, UTF-16BE, UTF-32LE, @@ -659,13 +670,12 @@ L option. =item * allow_dupkeys Allow decoding of duplicate keys in hashes. By default duplicate keys are forbidden. -See L: +See L: RFC 7159 section 4: "The names within an object should be unique." -See the L option. +See the C option. =back - =item $json = $json->canonical ([$enable]) =item $enabled = $json->get_canonical @@ -880,9 +890,29 @@ disable it, however with Perl hashes they are impossible, parsing JSON in Perl silently ignores duplicate names, using the last value found. -See L: +See L: RFC 7159 section 4: "The names within an object should be unique." +=item $json = $json->dupkeys_as_arrayref ([$enable]) + +=item $enabled = $json->get_dupkeys_as_arrayref + +If enabled, allow decoding of duplicate keys in hashes and store the +values as arrayref in the hash instead. By default duplicate keys are +forbidden. Enabling this also enables the L option, +but disabling this does not disable the L option. + +Example: + + $json->dupkeys_as_arrayref; + print encode_json ($json->decode ('{"a":"b","a":"c"}')); + + => {"a":["b","c"]} + +This changes the result structure, thus cannot be enabled by default. +The client must be aware of it. The resulting arrayref is not yet marked somehow +(blessed or such). + =item $json = $json->allow_blessed ([$enable]) =item $enabled = $json->get_allow_blessed @@ -2063,7 +2093,7 @@ output (modulo bugs, but C has found more bugs in the official JSON testsuite (1) than the official JSON testsuite has found in C (0)). C is currently the only known JSON decoder which passes all -L tests, while being the fastest also. +L tests, while being the fastest also. When you have trouble decoding JSON generated by this module using other decoders, then it is very likely that you have an encoding mismatch or the @@ -2315,10 +2345,18 @@ BEGIN { require overload; local $^W; # silence redefine warnings. no warnings 'redefine' does not help - &overload::import( 'overload', # workaround 5.6 reserved keyword warning - "0+" => sub { ${$_[0]} }, - "++" => sub { $_[0] = ${$_[0]} + 1 }, - "--" => sub { $_[0] = ${$_[0]} - 1 }, + # These already come with JSON::PP::Boolean. Avoid redefine warning. + if (!defined $JSON::PP::Boolean::VERSION or $JSON::PP::VERSION lt '4.00') { + &overload::unimport( 'overload', '0+', '++', '--' ); + &overload::import( 'overload', + "0+" => sub { ${$_[0]} }, + "++" => sub { $_[0] = ${$_[0]} + 1 }, + "--" => sub { $_[0] = ${$_[0]} - 1 }, + ); + } + # workaround 5.6 reserved keyword warning + &overload::unimport( 'overload', '""', 'eq', 'ne' ); + &overload::import( 'overload', '""' => sub { ${$_[0]} == 1 ? '1' : '0' }, # GH 29 'eq' => sub { my ($obj, $op) = $_[2] ? ($_[1], $_[0]) : ($_[0], $_[1]); diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Digest/SHA.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Digest/SHA.pm index dccc0e7aeb..37a31e969a 100644 --- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Digest/SHA.pm +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Digest/SHA.pm @@ -6,9 +6,10 @@ use strict; use warnings; use vars qw($VERSION @ISA @EXPORT_OK $errmsg); use Fcntl qw(O_RDONLY O_RDWR); +use Cwd qw(getcwd); use integer; -$VERSION = '6.02'; +$VERSION = '6.04'; require Exporter; @ISA = qw(Exporter); @@ -120,9 +121,18 @@ sub addfile { ## by attempting to open with mode O_RDWR local *FH; - $file eq '-' and open(FH, '< -') - or sysopen(FH, $file, -d $file ? O_RDWR : O_RDONLY) + if ($file eq '-') { + if (-d STDIN) { + sysopen(FH, getcwd(), O_RDWR) + or _bail('Open failed'); + } + open(FH, '< -') + or _bail('Open failed'); + } + else { + sysopen(FH, $file, -d $file ? O_RDWR : O_RDONLY) or _bail('Open failed'); + } if ($BITS) { my ($n, $buf) = (0, ""); @@ -810,7 +820,7 @@ darkness and moored it in so perfect a calm and in so brilliant a light" =head1 COPYRIGHT AND LICENSE -Copyright (C) 2003-2018 Mark Shelor +Copyright (C) 2003-2022 Mark Shelor This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Config.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Config.pm new file mode 100755 index 0000000000..64134c5a4b --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Config.pm @@ -0,0 +1,114 @@ +package ExtUtils::Config; +$ExtUtils::Config::VERSION = '0.008'; +use strict; +use warnings; +use Config; +use Data::Dumper (); + +sub new { + my ($pack, $args) = @_; + return bless { + values => ($args ? { %$args } : {}), + }, $pack; +} + +sub get { + my ($self, $key) = @_; + return exists $self->{values}{$key} ? $self->{values}{$key} : $Config{$key}; +} + +sub exists { + my ($self, $key) = @_; + return exists $self->{values}{$key} || exists $Config{$key}; +} + +sub values_set { + my $self = shift; + return { %{$self->{values}} }; +} + +sub all_config { + my $self = shift; + return { %Config, %{ $self->{values}} }; +} + +sub serialize { + my $self = shift; + return $self->{serialized} ||= Data::Dumper->new([$self->values_set])->Terse(1)->Sortkeys(1)->Dump; +} + +1; + +# ABSTRACT: A wrapper for perl's configuration + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +ExtUtils::Config - A wrapper for perl's configuration + +=head1 VERSION + +version 0.008 + +=head1 SYNOPSIS + + my $config = ExtUtils::Config->new(); + $config->get('installsitelib'); + +=head1 DESCRIPTION + +ExtUtils::Config is an abstraction around the %Config hash. By itself it is not a particularly interesting module by any measure, however it ties together a family of modern toolchain modules. + +=head1 METHODS + +=head2 new(\%config) + +Create a new ExtUtils::Config object. The values in C<\%config> are used to initialize the object. + +=head2 get($key) + +Get the value of C<$key>. If not overridden it will return the value in %Config. + +=head2 exists($key) + +Tests for the existence of $key. + +=head2 values_set() + +Get a hashref of all overridden values. + +=head2 all_config() + +Get a hashref of the complete configuration, including overrides. + +=head2 serialize() + +This method serializes the object to some kind of string. + +=head1 AUTHORS + +=over 4 + +=item * + +Ken Williams + +=item * + +Leon Timmermans + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2006 by Ken Williams, Leon Timmermans. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers.pm new file mode 100755 index 0000000000..42c6cbfb92 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers.pm @@ -0,0 +1,131 @@ +package ExtUtils::Helpers; +$ExtUtils::Helpers::VERSION = '0.026'; +use strict; +use warnings FATAL => 'all'; +use Exporter 5.57 'import'; + +use Config; +use File::Basename qw/basename/; +use File::Spec::Functions qw/splitpath canonpath abs2rel splitdir/; +use Text::ParseWords 3.24 (); + +our @EXPORT_OK = qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/; + +BEGIN { + my %impl_for = ( MSWin32 => 'Windows', VMS => 'VMS'); + my $package = 'ExtUtils::Helpers::' . ($impl_for{$^O} || 'Unix'); + my $impl = $impl_for{$^O} || 'Unix'; + require "ExtUtils/Helpers/$impl.pm"; + "ExtUtils::Helpers::$impl"->import(); +} + +sub split_like_shell { + my ($string) = @_; + + return if not defined $string; + $string =~ s/^\s+|\s+$//g; + return if not length $string; + + return Text::ParseWords::shellwords($string); +} + +sub man1_pagename { + my $filename = shift; + return basename($filename).".$Config{man1ext}"; +} + +my %separator = ( + MSWin32 => '.', + VMS => '__', + os2 => '.', + cygwin => '.', +); +my $separator = $separator{$^O} || '::'; + +sub man3_pagename { + my ($filename, $base) = @_; + $base ||= 'lib'; + my ($vols, $dirs, $file) = splitpath(canonpath(abs2rel($filename, $base))); + $file = basename($file, qw/.pm .pod/); + my @dirs = grep { length } splitdir($dirs); + return join $separator, @dirs, "$file.$Config{man3ext}"; +} + +1; + +# ABSTRACT: Various portability utilities for module builders + +__END__ + +=pod + +=encoding utf-8 + +=head1 NAME + +ExtUtils::Helpers - Various portability utilities for module builders + +=head1 VERSION + +version 0.026 + +=head1 SYNOPSIS + + use ExtUtils::Helpers qw/make_executable split_like_shell/; + + unshift @ARGV, split_like_shell($ENV{PROGRAM_OPTS}); + write_script_to('Build'); + make_executable('Build'); + +=head1 DESCRIPTION + +This module provides various portable helper functions for module building modules. + +=head1 FUNCTIONS + +=head2 make_executable($filename) + +This makes a perl script executable. + +=head2 split_like_shell($string) + +This function splits a string the same way as the local platform does. + +=head2 detildefy($path) + +This function substitutes a tilde at the start of a path with the users homedir in an appropriate manner. + +=head2 man1_pagename($filename) + +Returns the man page filename for a script. + +=head2 man3_pagename($filename, $basedir) + +Returns the man page filename for a Perl library. + +=head1 ACKNOWLEDGEMENTS + +Olivier Mengué and Christian Walde made C work on Windows. + +=head1 AUTHORS + +=over 4 + +=item * + +Ken Williams + +=item * + +Leon Timmermans + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2004 by Ken Williams, Leon Timmermans. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Unix.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Unix.pm new file mode 100755 index 0000000000..24f5d01549 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Unix.pm @@ -0,0 +1,86 @@ +package ExtUtils::Helpers::Unix; +$ExtUtils::Helpers::Unix::VERSION = '0.026'; +use strict; +use warnings FATAL => 'all'; + +use Exporter 5.57 'import'; +our @EXPORT = qw/make_executable detildefy/; + +use Carp qw/croak/; +use Config; + +my $layer = $] >= 5.008001 ? ":raw" : ""; + +sub make_executable { + my $filename = shift; + my $current_mode = (stat $filename)[2] + 0; + if (-T $filename) { + open my $fh, "<$layer", $filename; + my @lines = <$fh>; + if (@lines and $lines[0] =~ s{ \A \#! \s* (?:/\S+/)? perl \b (.*) \z }{$Config{startperl}$1}xms) { + open my $out, ">$layer", "$filename.new" or croak "Couldn't open $filename.new: $!"; + print $out @lines; + close $out; + rename $filename, "$filename.bak" or croak "Couldn't rename $filename to $filename.bak"; + rename "$filename.new", $filename or croak "Couldn't rename $filename.new to $filename"; + unlink "$filename.bak"; + } + } + chmod $current_mode | oct(111), $filename; + return; +} + +sub detildefy { + my $value = shift; + # tilde with optional username + for ($value) { + s{ ^ ~ (?= /|$)} [ $ENV{HOME} || (getpwuid $>)[7] ]ex or # tilde without user name + s{ ^ ~ ([^/]+) (?= /|$) } { (getpwnam $1)[7] || "~$1" }ex; # tilde with user name + } + return $value; +} + +1; + +# ABSTRACT: Unix specific helper bits + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +ExtUtils::Helpers::Unix - Unix specific helper bits + +=head1 VERSION + +version 0.026 + +=for Pod::Coverage make_executable +split_like_shell +detildefy + +=head1 AUTHORS + +=over 4 + +=item * + +Ken Williams + +=item * + +Leon Timmermans + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2004 by Ken Williams, Leon Timmermans. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/VMS.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/VMS.pm new file mode 100755 index 0000000000..cd0e210065 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/VMS.pm @@ -0,0 +1,117 @@ +package ExtUtils::Helpers::VMS; +$ExtUtils::Helpers::VMS::VERSION = '0.026'; +use strict; +use warnings FATAL => 'all'; + +use Exporter 5.57 'import'; +our @EXPORT = qw/make_executable detildefy/; + +use File::Copy qw/copy/; + +sub make_executable { + my $filename = shift; + my $batchname = "$filename.com"; + copy($filename, $batchname); + ExtUtils::Helpers::Unix::make_executable($batchname); + return; +} + +sub detildefy { + my $arg = shift; + + # Apparently double ~ are not translated. + return $arg if ($arg =~ /^~~/); + + # Apparently ~ followed by whitespace are not translated. + return $arg if ($arg =~ /^~ /); + + if ($arg =~ /^~/) { + my $spec = $arg; + + # Remove the tilde + $spec =~ s/^~//; + + # Remove any slash following the tilde if present. + $spec =~ s#^/##; + + # break up the paths for the merge + my $home = VMS::Filespec::unixify($ENV{HOME}); + + # In the default VMS mode, the trailing slash is present. + # In Unix report mode it is not. The parsing logic assumes that + # it is present. + $home .= '/' unless $home =~ m#/$#; + + # Trivial case of just ~ by it self + if ($spec eq '') { + $home =~ s#/$##; + return $home; + } + + my ($hvol, $hdir, $hfile) = File::Spec::Unix->splitpath($home); + if ($hdir eq '') { + # Someone has tampered with $ENV{HOME} + # So hfile is probably the directory since this should be + # a path. + $hdir = $hfile; + } + + my ($vol, $dir, $file) = File::Spec::Unix->splitpath($spec); + + my @hdirs = File::Spec::Unix->splitdir($hdir); + my @dirs = File::Spec::Unix->splitdir($dir); + + unless ($arg =~ m#^~/#) { + # There is a home directory after the tilde, but it will already + # be present in in @hdirs so we need to remove it by from @dirs. + + shift @dirs; + } + my $newdirs = File::Spec::Unix->catdir(@hdirs, @dirs); + + $arg = File::Spec::Unix->catpath($hvol, $newdirs, $file); + } + return $arg; +} + +# ABSTRACT: VMS specific helper bits + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +ExtUtils::Helpers::VMS - VMS specific helper bits + +=head1 VERSION + +version 0.026 + +=for Pod::Coverage make_executable +detildefy + +=head1 AUTHORS + +=over 4 + +=item * + +Ken Williams + +=item * + +Leon Timmermans + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2004 by Ken Williams, Leon Timmermans. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Windows.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Windows.pm new file mode 100755 index 0000000000..8b232e400a --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Windows.pm @@ -0,0 +1,70 @@ +package ExtUtils::Helpers::Windows; +$ExtUtils::Helpers::Windows::VERSION = '0.026'; +use strict; +use warnings FATAL => 'all'; + +use Exporter 5.57 'import'; +our @EXPORT = qw/make_executable detildefy/; + +use Config; +use Carp qw/carp croak/; +use ExtUtils::PL2Bat 'pl2bat'; + +sub make_executable { + my $script = shift; + if (-T $script && $script !~ / \. (?:bat|cmd) $ /x) { + pl2bat(in => $script, update => 1); + } + return; +} + +sub detildefy { + my $value = shift; + $value =~ s{ ^ ~ (?= [/\\] | $ ) }[$ENV{USERPROFILE}]x if $ENV{USERPROFILE}; + return $value; +} + +1; + +# ABSTRACT: Windows specific helper bits + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +ExtUtils::Helpers::Windows - Windows specific helper bits + +=head1 VERSION + +version 0.026 + +=for Pod::Coverage make_executable +split_like_shell +detildefy + +=head1 AUTHORS + +=over 4 + +=item * + +Ken Williams + +=item * + +Leon Timmermans + +=back + +=head1 COPYRIGHT AND LICENSE + +This software is copyright (c) 2004 by Ken Williams, Leon Timmermans. + +This is free software; you can redistribute it and/or modify it under +the same terms as the Perl 5 programming language system itself. + +=cut diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/InstallPaths.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/InstallPaths.pm new file mode 100755 index 0000000000..d5bc16c2b8 --- /dev/null +++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/InstallPaths.pm @@ -0,0 +1,625 @@ +package ExtUtils::InstallPaths; +$ExtUtils::InstallPaths::VERSION = '0.012'; +use 5.006; +use strict; +use warnings; + +use File::Spec (); +use Carp (); +use ExtUtils::Config 0.002; + +my %complex_accessors = map { $_ => 1 } qw/prefix_relpaths install_sets/; +my %hash_accessors = map { $_ => 1 } qw/install_path install_base_relpaths original_prefix /; + +my %defaults = ( + installdirs => 'site', + install_base => undef, + prefix => undef, + verbose => 0, + create_packlist => 1, + dist_name => undef, + module_name => undef, + destdir => undef, + install_path => sub { {} }, + install_sets => \&_default_install_sets, + original_prefix => \&_default_original_prefix, + install_base_relpaths => \&_default_base_relpaths, + prefix_relpaths => \&_default_prefix_relpaths, +); + +sub _merge_shallow { + my ($name, $filter) = @_; + return sub { + my ($override, $config) = @_; + my $defaults = $defaults{$name}->($config); + $filter->($_) for grep $filter, values %$override; + return { %$defaults, %$override }; + } +} + +sub _merge_deep { + my ($name, $filter) = @_; + return sub { + my ($override, $config) = @_; + my $defaults = $defaults{$name}->($config); + my $pair_for = sub { + my $key = shift; + my %override = %{ $override->{$key} || {} }; + $filter && $filter->($_) for values %override; + return $key => { %{ $defaults->{$key} }, %override }; + }; + return { map { $pair_for->($_) } keys %$defaults }; + } +} + +my %allowed_installdir = map { $_ => 1 } qw/core site vendor/; +my $must_be_relative = sub { Carp::croak('Value must be a relative path') if File::Spec->file_name_is_absolute($_[0]) }; +my %deep_filter = map { $_ => $must_be_relative } qw/install_base_relpaths prefix_relpaths/; +my %filter = ( + installdirs => sub { + my $value = shift; + $value = 'core', Carp::carp('Perhaps you meant installdirs to be "core" rather than "perl"?') if $value eq 'perl'; + Carp::croak('installdirs must be one of "core", "site", or "vendor"') if not $allowed_installdir{$value}; + return $value; + }, + (map { $_ => _merge_shallow($_, $deep_filter{$_}) } qw/original_prefix install_base_relpaths/), + (map { $_ => _merge_deep($_, $deep_filter{$_}) } qw/install_sets prefix_relpaths/), +); + +sub new { + my ($class, %args) = @_; + my $config = $args{config} || ExtUtils::Config->new; + my %self = ( + config => $config, + map { $_ => exists $args{$_} ? $filter{$_} ? $filter{$_}->($args{$_}, $config) : $args{$_} : ref $defaults{$_} ? $defaults{$_}->($config) : $defaults{$_} } keys %defaults, + ); + $self{module_name} ||= do { my $module_name = $self{dist_name}; $module_name =~ s/-/::/g; $module_name } if defined $self{dist_name}; + return bless \%self, $class; +} + +for my $attribute (keys %defaults) { + no strict qw/refs/; + *{$attribute} = $hash_accessors{$attribute} ? + sub { + my ($self, $key) = @_; + Carp::confess("$attribute needs key") if not defined $key; + return $self->{$attribute}{$key}; + } : + $complex_accessors{$attribute} ? + sub { + my ($self, $installdirs, $key) = @_; + Carp::confess("$attribute needs installdir") if not defined $installdirs; + Carp::confess("$attribute needs key") if not defined $key; + return $self->{$attribute}{$installdirs}{$key}; + } : + sub { + my $self = shift; + return $self->{$attribute}; + }; +} + +my $script = $] > 5.008000 ? 'script' : 'bin'; +my @install_sets_keys = qw/lib arch bin script bindoc libdoc binhtml libhtml/; +my @install_sets_tail = ('bin', $script, qw/man1dir man3dir html1dir html3dir/); +my %install_sets_values = ( + core => [ qw/privlib archlib /, @install_sets_tail ], + site => [ map { "site$_" } qw/lib arch/, @install_sets_tail ], + vendor => [ map { "vendor$_" } qw/lib arch/, @install_sets_tail ], +); + +sub _default_install_sets { + my $c = shift; + + my %ret; + for my $installdir (qw/core site vendor/) { + @{$ret{$installdir}}{@install_sets_keys} = map { $c->get("install$_") } @{ $install_sets_values{$installdir} }; + } + return \%ret; +} + +sub _default_base_relpaths { + my $config = shift; + return { + lib => ['lib', 'perl5'], + arch => ['lib', 'perl5', $config->get('archname')], + bin => ['bin'], + script => ['bin'], + bindoc => ['man', 'man1'], + libdoc => ['man', 'man3'], + binhtml => ['html'], + libhtml => ['html'], + }; +} + +my %common_prefix_relpaths = ( + bin => ['bin'], + script => ['bin'], + bindoc => ['man', 'man1'], + libdoc => ['man', 'man3'], + binhtml => ['html'], + libhtml => ['html'], +); + +sub _default_prefix_relpaths { + my $c = shift; + + my @libstyle = $c->get('installstyle') ? File::Spec->splitdir($c->get('installstyle')) : qw(lib perl5); + my $arch = $c->get('archname'); + my $version = $c->get('version'); + + return { + core => { + lib => [@libstyle], + arch => [@libstyle, $version, $arch], + %common_prefix_relpaths, + }, + vendor => { + lib => [@libstyle], + arch => [@libstyle, $version, $arch], + %common_prefix_relpaths, + }, + site => { + lib => [@libstyle, 'site_perl'], + arch => [@libstyle, 'site_perl', $version, $arch], + %common_prefix_relpaths, + }, + }; +} + +sub _default_original_prefix { + my $c = shift; + + my %ret = ( + core => $c->get('installprefixexp'), + site => $c->get('siteprefixexp'), + vendor => $c->get('usevendorprefix') ? $c->get('vendorprefixexp') : '', + ); + + return \%ret; +} + +sub _log_verbose { + my $self = shift; + print @_ if $self->verbose; + return; +} + +# Given a file type, will return true if the file type would normally +# be installed when neither install-base nor prefix has been set. +# I.e. it will be true only if the path is set from Config.pm or +# set explicitly by the user via install-path. +sub is_default_installable { + my $self = shift; + my $type = shift; + my $installable = $self->install_destination($type) && ( $self->install_path($type) || $self->install_sets($self->installdirs, $type)); + return $installable ? 1 : 0; +} + +sub _prefixify_default { + my $self = shift; + my $type = shift; + my $rprefix = shift; + + my $default = $self->prefix_relpaths($self->installdirs, $type); + if( !$default ) { + $self->_log_verbose(" no default install location for type '$type', using prefix '$rprefix'.\n"); + return $rprefix; + } else { + return File::Spec->catdir(@{$default}); + } +} + +# Translated from ExtUtils::MM_Unix::prefixify() +sub _prefixify_novms { + my($self, $path, $sprefix, $type) = @_; + + my $rprefix = $self->prefix; + $rprefix .= '/' if $sprefix =~ m{/$}; + + $self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n") if defined $path && length $path; + + if (not defined $path or length $path == 0 ) { + $self->_log_verbose(" no path to prefixify, falling back to default.\n"); + return $self->_prefixify_default( $type, $rprefix ); + } elsif( !File::Spec->file_name_is_absolute($path) ) { + $self->_log_verbose(" path is relative, not prefixifying.\n"); + } elsif( $path !~ s{^\Q$sprefix\E\b}{}s ) { + $self->_log_verbose(" cannot prefixify, falling back to default.\n"); + return $self->_prefixify_default( $type, $rprefix ); + } + + $self->_log_verbose(" now $path in $rprefix\n"); + + return $path; +} + +sub _catprefix_vms { + my ($self, $rprefix, $default) = @_; + + my ($rvol, $rdirs) = File::Spec->splitpath($rprefix); + if ($rvol) { + return File::Spec->catpath($rvol, File::Spec->catdir($rdirs, $default), ''); + } + else { + return File::Spec->catdir($rdirs, $default); + } +} +sub _prefixify_vms { + my($self, $path, $sprefix, $type) = @_; + my $rprefix = $self->prefix; + + return '' unless defined $path; + + $self->_log_verbose(" prefixify $path from $sprefix to $rprefix\n"); + + require VMS::Filespec; + # Translate $(PERLPREFIX) to a real path. + $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix; + $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix; + + $self->_log_verbose(" rprefix translated to $rprefix\n sprefix translated to $sprefix\n"); + + if (length($path) == 0 ) { + $self->_log_verbose(" no path to prefixify.\n") + } + elsif (!File::Spec->file_name_is_absolute($path)) { + $self->_log_verbose(" path is relative, not prefixifying.\n"); + } + elsif ($sprefix eq $rprefix) { + $self->_log_verbose(" no new prefix.\n"); + } + else { + my ($path_vol, $path_dirs) = File::Spec->splitpath( $path ); + my $vms_prefix = $self->config->get('vms_prefix'); + if ($path_vol eq $vms_prefix.':') { + $self->_log_verbose(" $vms_prefix: seen\n"); + + $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.}; + $path = $self->_catprefix_vms($rprefix, $path_dirs); + } + else { + $self->_log_verbose(" cannot prefixify.\n"); + return File::Spec->catdir($self->prefix_relpaths($self->installdirs, $type)); + } + } + + $self->_log_verbose(" now $path\n"); + + return $path; +} + +BEGIN { *_prefixify = $^O eq 'VMS' ? \&_prefixify_vms : \&_prefixify_novms } + +# Translated from ExtUtils::MM_Any::init_INSTALL_from_PREFIX +sub prefix_relative { + my ($self, $installdirs, $type) = @_; + + my $relpath = $self->install_sets($installdirs, $type); + + return $self->_prefixify($relpath, $self->original_prefix($installdirs), $type); +} + +sub install_destination { + my ($self, $type) = @_; + + return $self->install_path($type) if $self->install_path($type); + + if ( $self->install_base ) { + my $relpath = $self->install_base_relpaths($type); + return $relpath ? File::Spec->catdir($self->install_base, @{$relpath}) : undef; + } + + if ( $self->prefix ) { + my $relpath = $self->prefix_relative($self->installdirs, $type); + return $relpath ? File::Spec->catdir($self->prefix, $relpath) : undef; + } + return $self->install_sets($self->installdirs, $type); +} + +sub install_types { + my $self = shift; + + my %types = ( %{ $self->{install_path} }, + $self->install_base ? %{ $self->{install_base_relpaths} } + : $self->prefix ? %{ $self->{prefix_relpaths}{ $self->installdirs } } + : %{ $self->{install_sets}{ $self->installdirs } }); + + return sort keys %types; +} + +sub install_map { + my ($self, $dirs) = @_; + + my %localdir_for; + if ($dirs && %$dirs) { + %localdir_for = %$dirs; + } + else { + foreach my $type ($self->install_types) { + $localdir_for{$type} = File::Spec->catdir('blib', $type); + } + } + + my (%map, @skipping); + foreach my $type (keys %localdir_for) { + next if not -e $localdir_for{$type}; + if (my $dest = $self->install_destination($type)) { + $map{$localdir_for{$type}} = $dest; + } else { + push @skipping, $type; + } + } + + warn "WARNING: Can't figure out install path for types: @skipping\nFiles will not be installed.\n" if @skipping; + + # Write the packlist into the same place as ExtUtils::MakeMaker. + if ($self->create_packlist and my $module_name = $self->module_name) { + my $archdir = $self->install_destination('arch'); + my @ext = split /::/, $module_name; + $map{write} = File::Spec->catfile($archdir, 'auto', @ext, '.packlist'); + } + + # Handle destdir + if (length(my $destdir = $self->destdir || '')) { + foreach (keys %map) { + # Need to remove volume from $map{$_} using splitpath, or else + # we'll create something crazy like C:\Foo\Bar\E:\Baz\Quux + # VMS will always have the file separate than the path. + my ($volume, $path, $file) = File::Spec->splitpath( $map{$_}, 0 ); + + # catdir needs a list of directories, or it will create something + # crazy like volume:[Foo.Bar.volume.Baz.Quux] + my @dirs = File::Spec->splitdir($path); + + # First merge the directories + $path = File::Spec->catdir($destdir, @dirs); + + # Then put the file back on if there is one. + if ($file ne '') { + $map{$_} = File::Spec->catfile($path, $file) + } else { + $map{$_} = $path; + } + } + } + + $map{read} = ''; # To keep ExtUtils::Install quiet + + return \%map; +} + +1; + +# ABSTRACT: Build.PL install path logic made easy + +__END__ + +=pod + +=encoding UTF-8 + +=head1 NAME + +ExtUtils::InstallPaths - Build.PL install path logic made easy + +=head1 VERSION + +version 0.012 + +=head1 SYNOPSIS + + use ExtUtils::InstallPaths; + use ExtUtils::Install 'install'; + GetOptions(\my %opt, 'install_base=s', 'install_path=s%', 'installdirs=s', 'destdir=s', 'prefix=s', 'uninst:1', 'verbose:1'); + my $paths = ExtUtils::InstallPaths->new(%opt, dist_name => $dist_name); + install($paths->install_map, $opt{verbose}, 0, $opt{uninst}); + +=head1 DESCRIPTION + +This module tries to make install path resolution as easy as possible. + +When you want to install a module, it needs to figure out where to install things. The nutshell version of how this works is that default installation locations are determined from L, and they may be individually overridden by using the C attribute. An C attribute lets you specify an alternative installation root like F and C does something similar in a rather different (and more complicated) way. C lets you specify a temporary installation directory like F in case you want to create bundled-up installable packages. + +The following types are supported by default. + +=over 4 + +=item * lib + +Usually pure-Perl module files ending in F<.pm> or F<.pod>. + +=item * arch + +"Architecture-dependent" module files, usually produced by compiling XS, L, or similar code. + +=item * script + +Programs written in pure Perl. In order to improve reuse, you may want to make these as small as possible - put the code into modules whenever possible. + +=item * bin + +"Architecture-dependent" executable programs, i.e. compiled C code or something. Pretty rare to see this in a perl distribution, but it happens. + +=item * bindoc + +Documentation for the stuff in C