summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/site/lib
diff options
context:
space:
mode:
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site/lib')
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove.pm817
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State.pm548
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result.pm233
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/App/Prove/State/Result/Test.pm152
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS.pm66
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Digest/SHA.pm18
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Config.pm114
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers.pm131
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Unix.pm86
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/VMS.pm117
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/Helpers/Windows.pm70
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/ExtUtils/InstallPaths.pm625
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Listing.pm18
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm158
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm6
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm78
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm13
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm671
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm86
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm80
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm183
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/ConnCache.pm350
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug.pm112
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug/TraceHTTP.pm29
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/DebugFile.pm7
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MemberMixin.pm48
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol.pm313
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/cpan.pm72
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/data.pm52
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/file.pm147
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/ftp.pm555
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/gopher.pm213
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/http.pm523
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/loopback.pm27
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm184
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm150
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm25
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/RobotUA.pm312
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Simple.pm267
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/UserAgent.pm2179
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm22
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/Module/Build/Tiny.pm349
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA.pm21
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA/cacert.pem1274
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/mk-ca-bundle.pl625
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP.pm4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/Methods.pm4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm4
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/Socket.pm1143
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Base.pm133
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Base.pm490
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Color.pm116
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console.pm100
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/ParallelSession.pm201
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/Session.pm205
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File.pm56
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File/Session.pm95
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Session.pm220
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness.pm1072
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Beyond.pod426
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Env.pm215
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm155
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser.pm1931
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Aggregator.pm414
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Grammar.pm590
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator.pm162
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Array.pm100
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Process.pm381
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Stream.pm116
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/IteratorFactory.pm339
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Multiplexer.pm196
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result.pm297
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Bailout.pm62
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Comment.pm60
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Plan.pm119
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Pragma.pm62
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Test.pm271
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Unknown.pm48
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Version.pm62
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/YAML.pm61
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/ResultFactory.pm183
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler.pm448
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Job.pm127
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Spinner.pm61
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Source.pm381
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler.pm191
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Executable.pm187
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/File.pm136
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Handle.pm124
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Perl.pm372
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/RawTAP.pm130
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Reader.pm347
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Writer.pm263
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm30
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/HACKING.pod264
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Harness.pm618
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm8
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Warnings.pm587
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm202
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm45
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm190
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm33
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm22
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm99
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm9
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm6
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm23
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm418
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icap.pm76
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm76
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm42
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm6
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/.packlist15
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.dllbin103936 -> 67072 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.expbin0 -> 909 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.libbin0 -> 1708 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.pdbbin0 -> 733184 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Date/Parse/.packlist78
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/.packlist11
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.dllbin47616 -> 41984 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.expbin0 -> 887 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.libbin0 -> 1694 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.pdbbin0 -> 602112 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/Locale/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/compat/.packlist8
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Config/.packlist1
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Helpers/.packlist4
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/InstallPaths/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Listing/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Which/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/.packlist19
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.dllbin51200 -> 41472 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.expbin0 -> 902 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.libbin0 -> 1736 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.pdbbin0 -> 643072 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Tagset/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Cookies/.packlist6
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Daemon/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Date/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Message/.packlist20
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Negotiate/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/HTML/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/String/.packlist2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/JSON/MaybeXS/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/LWP/MediaTypes/.packlist4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/.packlist13
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.dllbin61440 -> 51712 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.expbin0 -> 893 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.libbin0 -> 1718 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.pdbbin0 -> 675840 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Module/Build/Tiny/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Mozilla/CA/.packlist5
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Net/HTTP/.packlist8
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/.packlist5
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.dllbin0 -> 35840 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.expbin0 -> 870 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.libbin0 -> 1706 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.pdbbin0 -> 618496 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Fatal/.packlist2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Harness/.packlist52
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Needs/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/RequiresInternet/.packlist2
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Warnings/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Try/Tiny/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/URI/.packlist111
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/WWW/RobotRules/.packlist4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/.packlist20
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.dllbin30720 -> 17920 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.expbin0 -> 879 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.libbin0 -> 1688 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.pdbbin0 -> 331776 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.dllbin47616 -> 14848 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.expbin0 -> 959 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.libbin0 -> 1800 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.pdbbin0 -> 315392 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/.packlist7
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.dllbin70144 -> 42496 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.expbin0 -> 919 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.libbin0 -> 1756 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.pdbbin0 -> 675840 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/.packlist7
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.dllbin53248 -> 23040 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.expbin0 -> 928 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.libbin0 -> 1774 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.pdbbin0 -> 733184 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/TieRegistry/.packlist4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/.packlist9
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.dllbin158720 -> 134656 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.expbin0 -> 946 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.libbin0 -> 1790 bytes
-rwxr-xr-xsystems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.pdbbin0 -> 815104 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/libwww/perl/.packlist33
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwpcook.pod310
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwptut.pod820
246 files changed, 19974 insertions, 9481 deletions
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<prove> command.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+L<Test::Harness> provides a command, C<prove>, which runs a TAP based
+test suite and prints a report. The C<prove> 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<new>
+
+Create a new C<App::Prove>. 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<state_class>
+
+Getter/setter for the name of the class used for maintaining state. This
+class should either subclass from C<App::Prove::State> or provide an identical
+interface.
+
+=head3 C<state_manager>
+
+Getter/setter for the instance of the C<state_class>.
+
+=cut
+
+=head3 C<add_rc_file>
+
+ $prove->add_rc_file('myproj/.proverc');
+
+Called before C<process_args> 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 = <RC> ) ) {
+ push @{ $self->{rc_opts} },
+ grep { defined and not /^#/ }
+ $line =~ m{ ' ([^']*) ' | " ([^"]*) " | (\#.*) | (\S+) }xg;
+ }
+ close RC;
+}
+
+=head3 C<process_args>
+
+ $prove->process_args(@args);
+
+Processes the command-line arguments. Attributes will be set
+appropriately. Any filenames may be found in the C<argv> 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 =~ /(?<!\\)=/ ) {
+
+ # It's a hash option.
+ croak "Option $name must be consistently used as a hash"
+ if exists $config{$k} && ref $config{$k} ne 'HASH';
+ $config{$k} ||= {};
+ my ( $hk, $hv ) = split /(?<!\\)=/, $v, 2;
+ $config{$k}{$hk} = $hv;
+ }
+ else {
+ $v =~ s/\\=/=/g;
+ if ( exists $config{$k} ) {
+ $config{$k} = [ $config{$k} ]
+ unless ref $config{$k} eq 'ARRAY';
+ push @{ $config{$k} } => $v;
+ }
+ else {
+ $config{$k} = $v;
+ }
+ }
+ }
+ );
+ $self->{argv} = \@ARGV;
+ return ( $handler, \%config );
+}
+
+=head3 C<run>
+
+Perform whatever actions the command line args specified. The C<prove>
+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<require_harness>
+
+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<print_version>
+
+Display the version numbers of the loaded L<TAP::Harness> 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<run>.
+
+=over
+
+=item C<archive>
+
+=item C<argv>
+
+=item C<backwards>
+
+=item C<blib>
+
+=item C<color>
+
+=item C<directives>
+
+=item C<dry>
+
+=item C<exec>
+
+=item C<extensions>
+
+=item C<failures>
+
+=item C<comments>
+
+=item C<formatter>
+
+=item C<harness>
+
+=item C<ignore_exit>
+
+=item C<includes>
+
+=item C<jobs>
+
+=item C<lib>
+
+=item C<merge>
+
+=item C<modules>
+
+=item C<parse>
+
+=item C<plugins>
+
+=item C<quiet>
+
+=item C<really_quiet>
+
+=item C<recurse>
+
+=item C<rules>
+
+=item C<show_count>
+
+=item C<show_help>
+
+=item C<show_man>
+
+=item C<show_version>
+
+=item C<shuffle>
+
+=item C<state>
+
+=item C<state_class>
+
+=item C<taint_fail>
+
+=item C<taint_warn>
+
+=item C<test_args>
+
+=item C<timer>
+
+=item C<verbose>
+
+=item C<warnings_fail>
+
+=item C<warnings_warn>
+
+=item C<tapversion>
+
+=item C<trap>
+
+=back
+
+=head1 PLUGINS
+
+C<App::Prove> provides support for 3rd-party plugins. These are currently
+loaded at run-time, I<after> arguments have been parsed (so you can not
+change the way arguments are processed, sorry), typically with the
+C<< -PI<plugin> >> switch, eg:
+
+ prove -PMyPlugin
+
+This will search for a module named C<App::Prove::Plugin::MyPlugin>, or failing
+that, C<MyPlugin>. If the plugin can't be found, C<prove> 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<load()> class method (if it has one),
+along with a reference to the C<App::Prove> 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<prove>, L<TAP::Harness>
+
+=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<prove> command.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+The C<prove> 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<new>
+
+Accepts a hashref with the following key/value pairs:
+
+=over 4
+
+=item * C<store>
+
+The filename of the data store holding the data that App::Prove::State reads.
+
+=item * C<extensions> (optional)
+
+The test name extensions. Defaults to C<.t>.
+
+=item * C<result_class> (optional)
+
+The name of the C<result_class>. Defaults to C<App::Prove::State::Result>.
+
+=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<result_class>
+
+Getter/setter for the name of the class used for tracking test results. This
+class should either subclass from C<App::Prove::State::Result> or provide an
+identical interface.
+
+=cut
+
+=head2 C<extensions>
+
+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<results>
+
+Get the results of the last test run. Returns a C<result_class()> instance.
+
+=cut
+
+sub results {
+ my $self = shift;
+ $self->{_} || $self->result_class->new;
+}
+
+=head2 C<commit>
+
+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<apply_switch>
+
+ $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<last>
+
+Run in the same order as last time
+
+=item C<failed>
+
+Run only the failed tests from last time
+
+=item C<passed>
+
+Run only the passed tests from last time
+
+=item C<all>
+
+Run all tests in normal order
+
+=item C<hot>
+
+Run the tests that most recently failed first
+
+=item C<todo>
+
+Run the tests ordered by number of todos.
+
+=item C<slow>
+
+Run the tests in slowest to fastest order.
+
+=item C<fast>
+
+Run test tests in fastest to slowest order.
+
+=item C<new>
+
+Run the tests in newest to oldest order.
+
+=item C<old>
+
+Run the tests in oldest to newest order.
+
+=item C<save>
+
+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<get_tests>
+
+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 => <STDIN>;
+ 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<observe_test>
+
+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<save>
+
+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>
+
+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 = <FH>;
+ 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<prove> 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<new>
+
+ my $result = App::Prove::State::Result->new({
+ generation => $generation,
+ tests => \%tests,
+ });
+
+Returns a new C<App::Prove::State::Result> 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<state_version>
+
+Returns the current version of state storage.
+
+=cut
+
+sub state_version {STATE_VERSION}
+
+=head2 C<test_class>
+
+Returns the name of the class used for tracking individual tests. This class
+should either subclass from C<App::Prove::State::Result::Test> 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<generation>
+
+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<last_run_time>
+
+Getter/setter for the time of the test suite run.
+
+=head3 C<tests>
+
+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<test>
+
+ my $test = $result->test('t/customer/create.t');
+
+Returns an individual C<App::Prove::State::Result::Test> instance for the
+given test name (usually the filename). Will return a new
+C<App::Prove::State::Result::Test> 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<test_names>
+
+Returns an list of test names, sorted by run order.
+
+=cut
+
+sub test_names {
+ my $self = shift;
+ return map { $_->name } $self->tests;
+}
+
+=head3 C<remove>
+
+ $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<num_tests>
+
+Returns the number of tests for a given test suite result.
+
+=cut
+
+sub num_tests { keys %{ shift->{tests} } }
+
+=head3 C<raw>
+
+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<prove> 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<new>
+
+=cut
+
+sub new {
+ my ( $class, $arg_for ) = @_;
+ $arg_for ||= {};
+ bless $arg_for => $class;
+}
+
+=head2 Instance Methods
+
+=head3 C<name>
+
+The name of the test. Usually a filename.
+
+=head3 C<elapsed>
+
+The total elapsed times the test took to run, in seconds from the epoch..
+
+=head3 C<generation>
+
+The number for the "generation" of the test run. The first generation is 1
+(one) and subsequent generations are 2, 3, etc.
+
+=head3 C<last_pass_time>
+
+The last time the test program passed, in seconds from the epoch.
+
+Returns C<undef> if the program has never passed.
+
+=head3 C<last_fail_time>
+
+The last time the test suite failed, in seconds from the epoch.
+
+Returns C<undef> if the program has never failed.
+
+=head3 C<mtime>
+
+Returns the mtime of the test, in seconds from the epoch.
+
+=head3 C<raw>
+
+Returns a hashref of raw test data, suitable for serialization by YAML.
+
+=head3 C<result>
+
+Currently, whether or not the test suite passed with no 'problems' (such as
+TODO passed).
+
+=head3 C<run_time>
+
+The total time it took for the test to run, in seconds. If C<Time::HiRes> is
+available, it will have finer granularity.
+
+=head3 C<num_todo>
+
+The number of tests with TODO directives.
+
+=head3 C<sequence>
+
+The order in which this test was run for the given test suite result.
+
+=head3 C<total_passes>
+
+The number of times the test has passed.
+
+=head3 C<total_failures>
+
+The number of times the test has failed.
+
+=head3 C<parser>
+
+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<https://rt.cpan.org/Public/Dist/Display.html?Queue=Cpanel-JSON-XS>
B<Changes to JSON::XS>
+- 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<Changes to JSON::XS>
- 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<Changes to JSON::XS>
- #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<Changes to JSON::XS>
- 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<BOM|/BOM>'s: UTF-8, UTF-16LE, UTF-16BE, UTF-32LE,
@@ -659,13 +670,12 @@ L</allow_barekey> option.
=item * allow_dupkeys
Allow decoding of duplicate keys in hashes. By default duplicate keys are forbidden.
-See L<http://seriot.ch/parsing_json.php#24>:
+See L<http://seriot.ch/projects/parsing_json.php#24>:
RFC 7159 section 4: "The names within an object should be unique."
-See the L</allow_dupkeys> option.
+See the C<allow_dupkeys> 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<http://seriot.ch/parsing_json.php#24>:
+See L<http://seriot.ch/projects/parsing_json.php#24>:
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</allow_dupkeys> option,
+but disabling this does not disable the L</allow_dupkeys> 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<JSON::XS> has found more bugs in the
official JSON testsuite (1) than the official JSON testsuite has found
in C<JSON::XS> (0)).
C<Cpanel::JSON::XS> is currently the only known JSON decoder which passes all
-L<http://seriot.ch/parsing_json.html> tests, while being the fastest also.
+L<http://seriot.ch/projects/parsing_json.html> 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 <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=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<make_executable> work on Windows.
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Ken Williams <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=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 <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=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 <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=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 <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=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<ExtUtils::Config>, and they may be individually overridden by using the C<install_path> attribute. An C<install_base> attribute lets you specify an alternative installation root like F</home/foo> and C<prefix> does something similar in a rather different (and more complicated) way. C<destdir> lets you specify a temporary installation directory like F</tmp/install> 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<Inline>, 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<script> and C<bin>. Usually generated from the POD in those files. Under Unix, these are manual pages belonging to the 'man1' category. Unless explicitly set, this is only available on platforms supporting manpages.
+
+=item * libdoc
+
+Documentation for the stuff in C<lib> and C<arch>. This is usually generated from the POD in F<.pm> and F<.pod> files. Under Unix, these are manual pages belonging to the 'man3' category. Unless explicitly set, this is only available on platforms supporting manpages.
+
+=item * binhtml
+
+This is the same as C<bindoc> above, but applies to HTML documents. Unless explicitly set, this is only available when perl was configured to do so.
+
+=item * libhtml
+
+This is the same as C<libdoc> above, but applies to HTML documents. Unless explicitly set, this is only available when perl was configured to do so.
+
+=back
+
+=head1 ATTRIBUTES
+
+=head2 installdirs
+
+The default destinations for these installable things come from entries in your system's configuration. You can select from three different sets of default locations by setting the C<installdirs> parameter as follows:
+
+ 'installdirs' set to:
+ core site vendor
+
+ uses the following defaults from ExtUtils::Config:
+
+ lib => installprivlib installsitelib installvendorlib
+ arch => installarchlib installsitearch installvendorarch
+ script => installscript installsitescript installvendorscript
+ bin => installbin installsitebin installvendorbin
+ bindoc => installman1dir installsiteman1dir installvendorman1dir
+ libdoc => installman3dir installsiteman3dir installvendorman3dir
+ binhtml => installhtml1dir installsitehtml1dir installvendorhtml1dir [*]
+ libhtml => installhtml3dir installsitehtml3dir installvendorhtml3dir [*]
+
+ * Under some OS (eg. MSWin32) the destination for HTML documents is determined by the C<Config.pm> entry C<installhtmldir>.
+
+The default value of C<installdirs> is "site".
+
+=head2 install_base
+
+You can also set the whole bunch of installation paths by supplying the C<install_base> parameter to point to a directory on your system. For instance, if you set C<install_base> to "/home/ken" on a Linux system, you'll install as follows:
+
+ lib => /home/ken/lib/perl5
+ arch => /home/ken/lib/perl5/i386-linux
+ script => /home/ken/bin
+ bin => /home/ken/bin
+ bindoc => /home/ken/man/man1
+ libdoc => /home/ken/man/man3
+ binhtml => /home/ken/html
+ libhtml => /home/ken/html
+
+=head2 prefix
+
+This sets a prefix, identical to ExtUtils::MakeMaker's PREFIX option. This does something similar to C<install_base> in a much more complicated way.
+
+=head2 config()
+
+The L<ExtUtils::Config|ExtUtils::Config> object used for this object.
+
+=head2 verbose
+
+The verbosity of ExtUtils::InstallPaths. It defaults to 0
+
+=head2 create_packlist
+
+Together with C<module_name> this controls whether a packlist will be added; it defaults to 1.
+
+=head2 dist_name
+
+The name of the current module.
+
+=head2 module_name
+
+The name of the main module of the package. This is required for packlist creation, but in the future it may be replaced by dist_name. It defaults to C<dist_name =~ s/-/::/gr> if dist_name is set.
+
+=head2 destdir
+
+If you want to install everything into a temporary directory first (for instance, if you want to create a directory tree that a package manager like C<rpm> or C<dpkg> could create a package from), you can use the C<destdir> parameter. E.g. Setting C<destdir> to C<"/tmp/foo"> will effectively install to "/tmp/foo/$sitelib", "/tmp/foo/$sitearch", and the like, except that it will use C<File::Spec> to make the pathnames work correctly on whatever platform you're installing on.
+
+=head1 METHODS
+
+=head2 new
+
+Create a new ExtUtils::InstallPaths object. B<All attributes are valid arguments> to the constructor, as well as this:
+
+=over 4
+
+=item * install_path
+
+This must be a hashref with the type as keys and the destination as values.
+
+=item * install_base_relpaths
+
+This must be a hashref with types as keys and a path relative to the install_base as value.
+
+=item * prefix_relpaths
+
+This must be a hashref any of these three keys: core, vendor, site. Each of the values mush be a hashref with types as keys and a path relative to the prefix as value. You probably want to make these three hashrefs identical.
+
+=item * original_prefix
+
+This must be a hashref with the legal installdirs values as keys and the prefix directories as values.
+
+=item * install_sets
+
+This mush be a hashref with the legal installdirs are keys, and the values being hashrefs with types as keys and locations as values.
+
+=back
+
+=head2 install_map()
+
+Return a map suitable for use with L<ExtUtils::Install>. B<In most cases, this is the only method you'll need>.
+
+=head2 install_destination($type)
+
+Returns the destination of a certain type.
+
+=head2 install_types()
+
+Return a list of all supported install types in the current configuration.
+
+=head2 is_default_installable($type)
+
+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 the configuration object or set explicitly by the user via install_path.
+
+=head2 install_path($type)
+
+Gets the install path for a certain type.
+
+=head2 install_sets($installdirs, $type)
+
+Get the path for a certain C<$type> with a certain C<$installdirs>.
+
+=head2 install_base_relpaths($type, $relpath)
+
+Get the relative paths for use with install_base for a certain type.
+
+=head2 prefix_relative($installdirs, $type)
+
+Gets the path of a certain C<$type> and C<$installdirs> relative to the prefix.
+
+=head2 prefix_relpaths($install_dirs, $type)
+
+Get the default relative path to use in case the config install paths cannot be prefixified. You do not want to use this to get any relative path, but may require it to set it for custom types.
+
+=head2 original_prefix($installdirs)
+
+Get the original prefix for a certain type of $installdirs.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item * L<Build.PL spec|http://github.com/dagolden/cpan-api-buildpl/blob/master/lib/CPAN/API/BuildPL.pm>
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Ken Williams <kwilliams@cpan.org>
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2011 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/File/Listing.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Listing.pm
index b94c5b3910..de1e9eb5db 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Listing.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Listing.pm
@@ -4,10 +4,10 @@ use strict;
use warnings;
use Carp ();
use HTTP::Date qw(str2time);
-use base qw( Exporter );
+use Exporter 5.57 qw( import );
# ABSTRACT: Parse directory listing
-our $VERSION = '6.14'; # VERSION
+our $VERSION = '6.16'; # VERSION
sub Version { $File::Listing::VERSION; }
@@ -121,7 +121,7 @@ sub parse
push(@files, $pkg->line($line, $tz, $error));
}
}
- wantarray ? @files : \@files; ## no critic (Freenode::Wantarray)
+ wantarray ? @files : \@files; ## no critic (Community::Wantarray)
}
@@ -246,10 +246,14 @@ sub line
my ($date, $size_or_dir, $name, $size);
+ # usual format:
# 02-05-96 10:48AM 1415 src.slf
# 09-10-96 09:18AM <DIR> sl_util
+ # alternative dos format with four-digit year:
+ # 02-05-2022 10:48AM 1415 src.slf
+ # 09-10-2022 09:18AM <DIR> sl_util
if (($date, $size_or_dir, $name) =
- /^(\d\d-\d\d-\d\d\s+\d\d:\d\d\wM) # Date and time info
+ /^(\d\d-\d\d-\d{2,4}\s+\d\d:\d\d\wM) # Date and time info
\s+ # Some space
(<\w{3}>|\d+) # Dir or Size
\s+ # Some more space
@@ -399,7 +403,7 @@ File::Listing - Parse directory listing
=head1 VERSION
-version 6.14
+version 6.16
=head1 SYNOPSIS
@@ -544,6 +548,8 @@ Gavin Peters
Graeme Thompson
+Grant Street Group
+
Hans-H. Froehlich
Ian Kilgore
@@ -608,7 +614,7 @@ uid39246
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 1996-2020 by Gisle Aas.
+This software is copyright (c) 1996-2022 by Gisle Aas.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm
index 15a85de001..306ac9761a 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm
@@ -136,7 +136,7 @@ modify it under the same terms as Perl itself.
=cut
use strict;
-our $VERSION = '3.76';
+our $VERSION = '3.81';
our (%entity2char, %char2entity);
require 5.004;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm
index cf353714d6..5f4b7e8b6c 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm
@@ -4,7 +4,7 @@ use strict;
require HTML::Parser;
our @ISA = qw(HTML::Parser);
-our $VERSION = '3.76';
+our $VERSION = '3.81';
sub declaration { $_[0]->output("<!$_[1]>") }
sub process { $_[0]->output($_[2]) }
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm
index 3128924f51..e3e6df5bab 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm
@@ -91,7 +91,7 @@ use HTML::Entities ();
use strict;
our $DEBUG;
#$DEBUG = 1;
-our $VERSION = '3.76';
+our $VERSION = '3.81';
=item $hp = HTML::HeadParser->new
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm
index 267cf5f5ab..e2a652a757 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm
@@ -2,7 +2,7 @@ package HTML::LinkExtor;
require HTML::Parser;
our @ISA = qw(HTML::Parser);
-our $VERSION = '3.76';
+our $VERSION = '3.81';
=head1 NAME
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm
index d44d0a2f57..c7579821df 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm
@@ -2,7 +2,7 @@ package HTML::Parser;
use strict;
-our $VERSION = '3.76';
+our $VERSION = '3.81';
require HTML::Entities;
@@ -129,30 +129,32 @@ HTML::Parser - HTML parser class
=head1 SYNOPSIS
- use strict;
- use warnings;
- use HTML::Parser ();
-
- # Create parser object
- my $p = HTML::Parser->new(
- api_version => 3,
- start_h => [\&start, "tagname, attr"],
- end_h => [\&end, "tagname"],
- marked_sections => 1,
- );
-
- # Parse document text chunk by chunk
- $p->parse($chunk1);
- $p->parse($chunk2);
- # ...
- # signal end of document
- $p->eof;
-
- # Parse directly from file
- $p->parse_file("foo.html");
- # or
- open(my $fh, "<:utf8", "foo.html") || die;
- $p->parse_file($fh);
+ use strict;
+ use warnings;
+ use HTML::Parser ();
+
+ # Create parser object
+ my $p = HTML::Parser->new(
+ api_version => 3,
+ start_h => [\&start, "tagname, attr"],
+ end_h => [\&end, "tagname"],
+ marked_sections => 1,
+ );
+
+ # Parse document text chunk by chunk
+ $p->parse($chunk1);
+ $p->parse($chunk2);
+
+ # ...
+ # signal end of document
+ $p->eof;
+
+ # Parse directly from file
+ $p->parse_file("foo.html");
+
+ # or
+ open(my $fh, "<:utf8", "foo.html") || die;
+ $p->parse_file($fh);
=head1 DESCRIPTION
@@ -262,14 +264,14 @@ Parsing will also abort if one of the event handlers calls $p->eof.
The effect of this is the same as:
- while (1) {
- my $chunk = &$code_ref();
- if (!defined($chunk) || !length($chunk)) {
- $p->eof;
- return $p;
+ while (1) {
+ my $chunk = &$code_ref();
+ if (!defined($chunk) || !length($chunk)) {
+ $p->eof;
+ return $p;
+ }
+ $p->parse($chunk) || return undef;
}
- $p->parse($chunk) || return undef;
- }
But it is more efficient as this loop runs internally in XS code.
@@ -988,24 +990,24 @@ HTML::Parser version 2 callback methods.
This is equivalent to the following method calls:
- $p->handler(start => "start", "self, tagname, attr, attrseq, text");
- $p->handler(end => "end", "self, tagname, text");
- $p->handler(text => "text", "self, text, is_cdata");
- $p->handler(process => "process", "self, token0, text");
- $p->handler(
- comment => sub {
- my($self, $tokens) = @_;
- for (@$tokens) {$self->comment($_);}
- },
- "self, tokens"
- );
- $p->handler(
- declaration => sub {
- my $self = shift;
- $self->declaration(substr($_[0], 2, -1));
- },
- "self, text"
- );
+ $p->handler(start => "start", "self, tagname, attr, attrseq, text");
+ $p->handler(end => "end", "self, tagname, text");
+ $p->handler(text => "text", "self, text, is_cdata");
+ $p->handler(process => "process", "self, token0, text");
+ $p->handler(
+ comment => sub {
+ my ($self, $tokens) = @_;
+ for (@$tokens) { $self->comment($_); }
+ },
+ "self, tokens"
+ );
+ $p->handler(
+ declaration => sub {
+ my $self = shift;
+ $self->declaration(substr($_[0], 2, -1));
+ },
+ "self, text"
+ );
Setting up these handlers can also be requested with the "api_version =>
2" constructor option.
@@ -1023,19 +1025,21 @@ The first simple example shows how you might strip out comments from
an HTML document. We achieve this by setting up a comment handler that
does nothing and a default handler that will print out anything else:
- use HTML::Parser;
- HTML::Parser->new(
- default_h => [sub { print shift }, 'text'],
- comment_h => [""],
- )->parse_file(shift || die) || die $!;
+ use HTML::Parser ();
+ HTML::Parser->new(
+ default_h => [sub { print shift }, 'text'],
+ comment_h => [""],
+ )->parse_file(shift || die)
+ || die $!;
An alternative implementation is:
- use HTML::Parser;
- HTML::Parser->new(
- end_document_h => [sub { print shift }, 'skipped_text'],
- comment_h => [""],
- )->parse_file(shift || die) || die $!;
+ use HTML::Parser ();
+ HTML::Parser->new(
+ end_document_h => [sub { print shift }, 'skipped_text'],
+ comment_h => [""],
+ )->parse_file(shift || die)
+ || die $!;
This will in most cases be much more efficient since only a single
callback will be made.
@@ -1046,24 +1050,24 @@ handler. When it sees the title start tag it enables a text handler
that prints any text found and an end handler that will terminate
parsing as soon as the title end tag is seen:
- use HTML::Parser ();
-
- sub start_handler {
- return if shift ne "title";
- my $self = shift;
- $self->handler(text => sub { print shift }, "dtext");
- $self->handler(
- end => sub {
- shift->eof if shift eq "title";
- },
- "tagname,self"
- );
- }
+ use HTML::Parser ();
+
+ sub start_handler {
+ return if shift ne "title";
+ my $self = shift;
+ $self->handler(text => sub { print shift }, "dtext");
+ $self->handler(
+ end => sub {
+ shift->eof if shift eq "title";
+ },
+ "tagname,self"
+ );
+ }
- my $p = HTML::Parser->new(api_version => 3);
- $p->handler(start => \&start_handler, "tagname,self");
- $p->parse_file(shift || die) || die $!;
- print "\n";
+ my $p = HTML::Parser->new(api_version => 3);
+ $p->handler(start => \&start_handler, "tagname,self");
+ $p->parse_file(shift || die) || die $!;
+ print "\n";
More examples are found in the F<eg/> directory of the C<HTML-Parser>
distribution: the program C<hrefsub> shows how you can edit all links
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm
index d7b4885fea..b5275633d4 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm
@@ -4,7 +4,7 @@ use strict;
require HTML::Parser;
our @ISA = qw(HTML::Parser);
-our $VERSION = '3.76';
+our $VERSION = '3.81';
use Carp ();
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm
index 8a8239c3d0..90912a6e4b 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm
@@ -4,7 +4,7 @@ use strict;
require HTML::PullParser;
our @ISA = qw(HTML::PullParser);
-our $VERSION = '3.76';
+our $VERSION = '3.81';
use Carp ();
use HTML::Entities qw(decode_entities);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm
index 4f055d5b00..3e5b25639b 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm
@@ -5,7 +5,7 @@ use HTTP::Date qw(str2time parse_date time2str);
use HTTP::Headers::Util qw(_split_header_words join_header_words);
our $EPOCH_OFFSET;
-our $VERSION = '6.10';
+our $VERSION = '6.11';
# Legacy: because "use "HTTP::Cookies" used be the ONLY way
# to load the class HTTP::Cookies::Netscape.
@@ -682,7 +682,7 @@ HTTP::Cookies - HTTP cookie jars
=head1 VERSION
-version 6.10
+version 6.11
=head1 SYNOPSIS
@@ -803,7 +803,7 @@ attributes like "Comment" and "CommentURL".
=item $cookie_jar->save( file => $file, ignore_discard => $ignore_discard )
-This method file saves the state of the $cookie_jar to a file.
+This method saves the state of the $cookie_jar to a file.
The state can then be restored later using the load() method. If a
filename is not specified we will use the name specified during
construction. If the $ignore_discard value is true (or not specified,
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm
index 8f73ead280..caf912cf44 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm
@@ -2,7 +2,7 @@ package HTTP::Cookies::Microsoft;
use strict;
-our $VERSION = '6.10';
+our $VERSION = '6.11';
require HTTP::Cookies;
our @ISA=qw(HTTP::Cookies);
@@ -244,7 +244,7 @@ HTTP::Cookies::Microsoft - Access to Microsoft cookies files
=head1 VERSION
-version 6.10
+version 6.11
=head1 SYNOPSIS
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm
index 15b34c0307..fb7a18d7f6 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm
@@ -2,7 +2,7 @@ package HTTP::Cookies::Netscape;
use strict;
-our $VERSION = '6.10';
+our $VERSION = '6.11';
require HTTP::Cookies;
our @ISA=qw(HTTP::Cookies);
@@ -82,7 +82,7 @@ HTTP::Cookies::Netscape - Access to Netscape cookies files
=head1 VERSION
-version 6.10
+version 6.11
=head1 SYNOPSIS
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm
index c14f498d03..f9b321671e 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm
@@ -1,11 +1,11 @@
-package HTTP::Daemon; # git description: v6.13-4-ge6492b6
+package HTTP::Daemon; # git description: v6.15-4-gbab5825
# ABSTRACT: A simple http server class
use strict;
use warnings;
-our $VERSION = '6.14';
+our $VERSION = '6.16';
use Socket ();
use IO::Socket::IP;
@@ -192,9 +192,9 @@ READ_HEADER:
}
# Find out how much content to read
- my $te = $r->header('Transfer-Encoding');
- my $ct = $r->header('Content-Type');
- my $len = $r->header('Content-Length');
+ my $tr_enc = $r->header('Transfer-Encoding');
+ my $ct_type = $r->header('Content-Type');
+ my $ct_len = $r->header('Content-Length');
# Act on the Expect header, if it's there
for my $e ($r->header('Expect')) {
@@ -209,7 +209,7 @@ READ_HEADER:
}
}
- if ($te && lc($te) eq 'chunked') {
+ if ($tr_enc && lc($tr_enc) eq 'chunked') {
# Handle chunked transfer encoding
my $body = "";
@@ -280,32 +280,60 @@ READ_HEADER:
$r->push_header($key, $val) if $key;
}
- elsif ($te) {
+ elsif ($tr_enc) {
$self->send_error(501); # Unknown transfer encoding
- $self->reason("Unknown transfer encoding '$te'");
+ $self->reason("Unknown transfer encoding '$tr_enc'");
return;
}
- elsif ($len) {
+ elsif ($ct_len) {
+
+ # After a security issue, we ensure we comply to
+ # RFC-7230 -- HTTP/1.1 Message Syntax and Routing
+ # section 3.3.2 -- Content-Length
+ # section 3.3.3 -- Message Body Length
+
+ # split and clean up Content-Length ', ' separated string
+ my @vals = map {my $str = $_; $str =~ s/^\s+//; $str =~ s/\s+$//; $str }
+ split ',', $ct_len;
+ # check that they are all numbers (RFC: Content-Length = 1*DIGIT)
+ my @nums = grep { /^[0-9]+$/} @vals;
+ unless (@vals == @nums) {
+ my $reason = "Content-Length value must be an unsigned integer";
+ $self->send_error(400, $reason);
+ $self->reason($reason);
+ return;
+ }
+ # check they are all the same
+ my $ct_len = shift @nums;
+ foreach (@nums) {
+ next if $_ == $ct_len;
+ my $reason = "Content-Length values are not the same";
+ $self->send_error(400, $reason);
+ $self->reason($reason);
+ return;
+ }
+ # ensure we have now a fixed header, with only 1 value
+ $r->header('Content-Length' => $ct_len);
# Plain body specified by "Content-Length"
- my $missing = $len - length($buf);
+ my $missing = $ct_len - length($buf);
while ($missing > 0) {
print "Need $missing more bytes of content\n" if $DEBUG;
my $n = $self->_need_more($buf, $timeout, $fdset);
return unless $n;
$missing -= $n;
}
- if (length($buf) > $len) {
- $r->content(substr($buf, 0, $len));
- substr($buf, 0, $len) = '';
+ if (length($buf) > $ct_len) {
+ $r->content(substr($buf, 0, $ct_len));
+ substr($buf, 0, $ct_len) = '';
}
else {
$r->content($buf);
$buf = '';
}
}
- elsif ($ct && $ct =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*("?)(\w+)\1/i) {
+ elsif ($ct_type && $ct_type =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*("?)(\w+)\1/i) {
# Handle multipart content type
my $boundary = "$CRLF--$2--";
@@ -497,8 +525,8 @@ sub send_redirect {
print $self "Location: $loc$CRLF";
if ($content) {
- my $ct = $content =~ /^\s*</ ? "text/html" : "text/plain";
- print $self "Content-Type: $ct$CRLF";
+ my $ct_type = $content =~ /^\s*</ ? "text/html" : "text/plain";
+ print $self "Content-Type: $ct_type$CRLF";
}
print $self $CRLF;
print $self $content if $content && !$self->head_request;
@@ -537,12 +565,12 @@ sub send_file_response {
local (*F);
sysopen(F, $file, 0) or return $self->send_error(RC_FORBIDDEN);
binmode(F);
- my ($ct, $ce) = guess_media_type($file);
+ my ($mime_type, $file_enc) = guess_media_type($file);
my ($size, $mtime) = (stat _)[7, 9];
unless ($self->antique_client) {
$self->send_basic_header;
- print $self "Content-Type: $ct$CRLF";
- print $self "Content-Encoding: $ce$CRLF" if $ce;
+ print $self "Content-Type: $mime_type$CRLF";
+ print $self "Content-Encoding: $file_enc$CRLF" if $file_enc;
print $self "Content-Length: $size$CRLF" if $size;
print $self "Last-Modified: ", time2str($mtime), "$CRLF" if $mtime;
print $self $CRLF;
@@ -603,7 +631,7 @@ HTTP::Daemon - A simple http server class
=head1 VERSION
-version 6.14
+version 6.16
=head1 SYNOPSIS
@@ -915,7 +943,7 @@ Gisle Aas <gisle@activestate.com>
=head1 CONTRIBUTORS
-=for stopwords Olaf Alders Ville Skyttä Karen Etheridge Mark Stosberg Shoichi Kaji Chase Whitener Slaven Rezic Petr Písař Zefram Alexey Tourbin Bron Gondwana Michal Josef Špaček Mike Schilli Tom Hukins Adam Kennedy Sjogren Alex Kapranoff amire80 Andreas J. Koenig Bill Mann Daniel Hedlund David E. Wheeler DAVIDRW Father Chrysostomos Ferenc Erki FWILES Gavin Peters Graeme Thompson Hans-H. Froehlich Ian Kilgore Jacob J jefflee john9art murphy Ondrej Hanak Perlover Peter Rabbitson phrstbrn Robert Stone Rolf Grossmann ruff sasao Sean M. Burke Spiros Denaxas Steve Hay Todd Lipcon Tony Finch Toru Yamaguchi Yuri Karaban
+=for stopwords Olaf Alders Ville Skyttä Graham Knop Karen Etheridge Mark Stosberg Shoichi Kaji Chase Whitener Theo van Hoesel Slaven Rezic Petr Písař Zefram Alexey Tourbin Bron Gondwana Michal Josef Špaček Mike Schilli Tom Hukins Adam Kennedy Sjogren Alex Kapranoff amire80 Andreas J. Koenig Bill Mann Daniel Hedlund David E. Wheeler DAVIDRW Father Chrysostomos Ferenc Erki FWILES Gavin Peters Graeme Thompson Hans-H. Froehlich Ian Kilgore Jacob J jefflee john9art murphy Ondrej Hanak Perlover Peter Rabbitson phrstbrn Robert Stone Rolf Grossmann ruff sasao Sean M. Burke Spiros Denaxas Steve Hay Todd Lipcon Tony Finch Toru Yamaguchi Yuri Karaban
=over 4
@@ -929,6 +957,10 @@ Ville Skyttä <ville.skytta@iki.fi>
=item *
+Graham Knop <haarg@haarg.org>
+
+=item *
+
Karen Etheridge <ether@cpan.org>
=item *
@@ -945,6 +977,10 @@ Chase Whitener <capoeirab@cpan.org>
=item *
+Theo van Hoesel <tvanhoesel@perceptyx.com>
+
+=item *
+
Slaven Rezic <slaven@rezic.de>
=item *
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm
index a57d0b8ded..53711c5865 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm
@@ -2,7 +2,7 @@ package HTTP::Date;
use strict;
-our $VERSION = '6.05';
+our $VERSION = '6.06';
require Exporter;
our @ISA = qw(Exporter);
@@ -179,7 +179,7 @@ sub parse_date ($) {
||
- # Windows 'dir' 11-12-96 03:52PM
+ # Windows 'dir': '11-12-96 03:52PM' and four-digit year variant
(
( $mon, $day, $yr, $hr, $min, $ampm )
= /^
@@ -187,7 +187,7 @@ sub parse_date ($) {
-
(\d{2}) # day
-
- (\d{2}) # year
+ (\d{2,4}) # year
\s+
(\d\d?):(\d\d)([APap][Mm]) # hour:min AM or PM
\s*$
@@ -289,7 +289,7 @@ HTTP::Date - HTTP::Date - date conversion routines
=head1 VERSION
-version 6.05
+version 6.06
=head1 SYNOPSIS
@@ -378,7 +378,8 @@ The function is able to parse the following formats:
"Feb 3 1994" -- Unix 'ls -l' format
"Feb 3 17:03" -- Unix 'ls -l' format
- "11-15-96 03:52PM" -- Windows 'dir' format
+ "11-15-96 03:52PM" -- Windows 'dir' format
+ "11-15-1996 03:52PM" -- Windows 'dir' format with four-digit year
The parser ignores leading and trailing whitespace. It also allow the
seconds to be missing and the month to be numerical in most formats.
@@ -410,7 +411,7 @@ Gisle Aas <gisle@activestate.com>
=head1 COPYRIGHT AND LICENSE
-This software is copyright (c) 1995-2019 by Gisle Aas.
+This software is copyright (c) 1995 by Gisle Aas.
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm
deleted file mode 100644
index 1db7504a6e..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm
+++ /dev/null
@@ -1,671 +0,0 @@
-package LWP;
-
-our $VERSION = '6.61';
-
-require LWP::UserAgent; # this should load everything you need
-
-sub Version { $VERSION; }
-
-1;
-
-__END__
-
-=pod
-
-=encoding utf-8
-
-=head1 NAME
-
-LWP - The World-Wide Web library for Perl
-
-=head1 SYNOPSIS
-
- use LWP;
- print "This is libwww-perl-$LWP::VERSION\n";
-
-
-=head1 DESCRIPTION
-
-The libwww-perl collection is a set of Perl modules which provides a
-simple and consistent application programming interface (API) to the
-World-Wide Web. The main focus of the library is to provide classes
-and functions that allow you to write WWW clients. The library also
-contain modules that are of more general use and even classes that
-help you implement simple HTTP servers.
-
-Most modules in this library provide an object oriented API. The user
-agent, requests sent and responses received from the WWW server are
-all represented by objects. This makes a simple and powerful
-interface to these services. The interface is easy to extend
-and customize for your own needs.
-
-The main features of the library are:
-
-=over 3
-
-=item *
-
-Contains various reusable components (modules) that can be
-used separately or together.
-
-=item *
-
-Provides an object oriented model of HTTP-style communication. Within
-this framework we currently support access to C<http>, C<https>, C<gopher>,
-C<ftp>, C<news>, C<file>, and C<mailto> resources.
-
-=item *
-
-Provides a full object oriented interface or
-a very simple procedural interface.
-
-=item *
-
-Supports the basic and digest authorization schemes.
-
-=item *
-
-Supports transparent redirect handling.
-
-=item *
-
-Supports access through proxy servers.
-
-=item *
-
-Provides parser for F<robots.txt> files and a framework for constructing robots.
-
-=item *
-
-Supports parsing of HTML forms.
-
-=item *
-
-Implements HTTP content negotiation algorithm that can
-be used both in protocol modules and in server scripts (like CGI
-scripts).
-
-=item *
-
-Supports HTTP cookies.
-
-=item *
-
-Some simple command line clients, for instance C<lwp-request> and C<lwp-download>.
-
-=back
-
-
-=head1 HTTP STYLE COMMUNICATION
-
-
-The libwww-perl library is based on HTTP style communication. This
-section tries to describe what that means.
-
-Let us start with this quote from the HTTP specification document
-L<http://www.w3.org/Protocols/>:
-
-=over 3
-
-=item *
-
-The HTTP protocol is based on a request/response paradigm. A client
-establishes a connection with a server and sends a request to the
-server in the form of a request method, URI, and protocol version,
-followed by a MIME-like message containing request modifiers, client
-information, and possible body content. The server responds with a
-status line, including the message's protocol version and a success or
-error code, followed by a MIME-like message containing server
-information, entity meta-information, and possible body content.
-
-=back
-
-What this means to libwww-perl is that communication always take place
-through these steps: First a I<request> object is created and
-configured. This object is then passed to a server and we get a
-I<response> object in return that we can examine. A request is always
-independent of any previous requests, i.e. the service is stateless.
-The same simple model is used for any kind of service we want to
-access.
-
-For example, if we want to fetch a document from a remote file server,
-then we send it a request that contains a name for that document and
-the response will contain the document itself. If we access a search
-engine, then the content of the request will contain the query
-parameters and the response will contain the query result. If we want
-to send a mail message to somebody then we send a request object which
-contains our message to the mail server and the response object will
-contain an acknowledgment that tells us that the message has been
-accepted and will be forwarded to the recipient(s).
-
-It is as simple as that!
-
-
-=head2 The Request Object
-
-The libwww-perl request object has the class name L<HTTP::Request>.
-The fact that the class name uses C<HTTP::> as a
-prefix only implies that we use the HTTP model of communication. It
-does not limit the kind of services we can try to pass this I<request>
-to. For instance, we will send L<HTTP::Request>s both to ftp and
-gopher servers, as well as to the local file system.
-
-The main attributes of the request objects are:
-
-=over 3
-
-=item *
-
-B<method> is a short string that tells what kind of
-request this is. The most common methods are B<GET>, B<PUT>,
-B<POST> and B<HEAD>.
-
-=item *
-
-B<uri> is a string denoting the protocol, server and
-the name of the "document" we want to access. The B<uri> might
-also encode various other parameters.
-
-=item *
-
-B<headers> contains additional information about the
-request and can also used to describe the content. The headers
-are a set of keyword/value pairs.
-
-=item *
-
-B<content> is an arbitrary amount of data.
-
-=back
-
-=head2 The Response Object
-
-The libwww-perl response object has the class name L<HTTP::Response>.
-The main attributes of objects of this class are:
-
-=over 3
-
-=item *
-
-B<code> is a numerical value that indicates the overall
-outcome of the request.
-
-=item *
-
-B<message> is a short, human readable string that
-corresponds to the I<code>.
-
-=item *
-
-B<headers> contains additional information about the
-response and describe the content.
-
-=item *
-
-B<content> is an arbitrary amount of data.
-
-=back
-
-Since we don't want to handle all possible I<code> values directly in
-our programs, a libwww-perl response object has methods that can be
-used to query what kind of response this is. The most commonly used
-response classification methods are:
-
-=over 3
-
-=item is_success()
-
-The request was successfully received, understood or accepted.
-
-=item is_error()
-
-The request failed. The server or the resource might not be
-available, access to the resource might be denied or other things might
-have failed for some reason.
-
-=back
-
-=head2 The User Agent
-
-Let us assume that we have created a I<request> object. What do we
-actually do with it in order to receive a I<response>?
-
-The answer is that you pass it to a I<user agent> object and this
-object takes care of all the things that need to be done
-(like low-level communication and error handling) and returns
-a I<response> object. The user agent represents your
-application on the network and provides you with an interface that
-can accept I<requests> and return I<responses>.
-
-The user agent is an interface layer between
-your application code and the network. Through this interface you are
-able to access the various servers on the network.
-
-The class name for the user agent is L<LWP::UserAgent>. Every
-libwww-perl application that wants to communicate should create at
-least one object of this class. The main method provided by this
-object is request(). This method takes an L<HTTP::Request> object as
-argument and (eventually) returns a L<HTTP::Response> object.
-
-The user agent has many other attributes that let you
-configure how it will interact with the network and with your
-application.
-
-=over 3
-
-=item *
-
-B<timeout> specifies how much time we give remote servers to
-respond before the library disconnects and creates an
-internal I<timeout> response.
-
-=item *
-
-B<agent> specifies the name that your application uses when it
-presents itself on the network.
-
-=item *
-
-B<from> can be set to the e-mail address of the person
-responsible for running the application. If this is set, then the
-address will be sent to the servers with every request.
-
-=item *
-
-B<parse_head> specifies whether we should initialize response
-headers from the C<< <head> >> section of HTML documents.
-
-=item *
-
-B<proxy> and B<no_proxy> specify if and when to go through
-a proxy server. L<http://www.w3.org/History/1994/WWW/Proxies/>
-
-=item *
-
-B<credentials> provides a way to set up user names and
-passwords needed to access certain services.
-
-=back
-
-Many applications want even more control over how they interact
-with the network and they get this by sub-classing
-L<LWP::UserAgent>. The library includes a
-sub-class, L<LWP::RobotUA>, for robot applications.
-
-=head2 An Example
-
-This example shows how the user agent, a request and a response are
-represented in actual perl code:
-
- # Create a user agent object
- use LWP::UserAgent;
- my $ua = LWP::UserAgent->new;
- $ua->agent("MyApp/0.1 ");
-
- # Create a request
- my $req = HTTP::Request->new(POST => 'http://search.cpan.org/search');
- $req->content_type('application/x-www-form-urlencoded');
- $req->content('query=libwww-perl&mode=dist');
-
- # Pass request to the user agent and get a response back
- my $res = $ua->request($req);
-
- # Check the outcome of the response
- if ($res->is_success) {
- print $res->content;
- }
- else {
- print $res->status_line, "\n";
- }
-
-The C<$ua> is created once when the application starts up. New request
-objects should normally created for each request sent.
-
-
-=head1 NETWORK SUPPORT
-
-This section discusses the various protocol schemes and
-the HTTP style methods that headers may be used for each.
-
-For all requests, a "User-Agent" header is added and initialized from
-the C<< $ua->agent >> attribute before the request is handed to the network
-layer. In the same way, a "From" header is initialized from the
-$ua->from attribute.
-
-For all responses, the library adds a header called "Client-Date".
-This header holds the time when the response was received by
-your application. The format and semantics of the header are the
-same as the server created "Date" header. You may also encounter other
-"Client-XXX" headers. They are all generated by the library
-internally and are not received from the servers.
-
-=head2 HTTP Requests
-
-HTTP requests are just handed off to an HTTP server and it
-decides what happens. Few servers implement methods beside the usual
-"GET", "HEAD", "POST" and "PUT", but CGI-scripts may implement
-any method they like.
-
-If the server is not available then the library will generate an
-internal error response.
-
-The library automatically adds a "Host" and a "Content-Length" header
-to the HTTP request before it is sent over the network.
-
-For a GET request you might want to add an "If-Modified-Since" or
-"If-None-Match" header to make the request conditional.
-
-For a POST request you should add the "Content-Type" header. When you
-try to emulate HTML E<lt>FORM> handling you should usually let the value
-of the "Content-Type" header be "application/x-www-form-urlencoded".
-See L<lwpcook> for examples of this.
-
-The libwww-perl HTTP implementation currently support the HTTP/1.1
-and HTTP/1.0 protocol.
-
-The library allows you to access proxy server through HTTP. This
-means that you can set up the library to forward all types of request
-through the HTTP protocol module. See L<LWP::UserAgent> for
-documentation of this.
-
-
-=head2 HTTPS Requests
-
-HTTPS requests are HTTP requests over an encrypted network connection
-using the SSL protocol developed by Netscape. Everything about HTTP
-requests above also apply to HTTPS requests. In addition the library
-will add the headers "Client-SSL-Cipher", "Client-SSL-Cert-Subject" and
-"Client-SSL-Cert-Issuer" to the response. These headers denote the
-encryption method used and the name of the server owner.
-
-The request can contain the header "If-SSL-Cert-Subject" in order to
-make the request conditional on the content of the server certificate.
-If the certificate subject does not match, no request is sent to the
-server and an internally generated error response is returned. The
-value of the "If-SSL-Cert-Subject" header is interpreted as a Perl
-regular expression.
-
-
-=head2 FTP Requests
-
-The library currently supports GET, HEAD and PUT requests. GET
-retrieves a file or a directory listing from an FTP server. PUT
-stores a file on a ftp server.
-
-You can specify a ftp account for servers that want this in addition
-to user name and password. This is specified by including an "Account"
-header in the request.
-
-User name/password can be specified using basic authorization or be
-encoded in the URL. Failed logins return an UNAUTHORIZED response with
-"WWW-Authenticate: Basic" and can be treated like basic authorization
-for HTTP.
-
-The library supports ftp ASCII transfer mode by specifying the "type=a"
-parameter in the URL. It also supports transfer of ranges for FTP transfers
-using the "Range" header.
-
-Directory listings are by default returned unprocessed (as returned
-from the ftp server) with the content media type reported to be
-"text/ftp-dir-listing". The L<File::Listing> module provides methods
-for parsing of these directory listing.
-
-The ftp module is also able to convert directory listings to HTML and
-this can be requested via the standard HTTP content negotiation
-mechanisms (add an "Accept: text/html" header in the request if you
-want this).
-
-For normal file retrievals, the "Content-Type" is guessed based on the
-file name suffix. See L<LWP::MediaTypes>.
-
-The "If-Modified-Since" request header works for servers that implement
-the C<MDTM> command. It will probably not work for directory listings though.
-
-Example:
-
- $req = HTTP::Request->new(GET => 'ftp://me:passwd@ftp.some.where.com/');
- $req->header(Accept => "text/html, */*;q=0.1");
-
-=head2 News Requests
-
-Access to the USENET News system is implemented through the NNTP
-protocol. The name of the news server is obtained from the
-NNTP_SERVER environment variable and defaults to "news". It is not
-possible to specify the hostname of the NNTP server in news: URLs.
-
-The library supports GET and HEAD to retrieve news articles through the
-NNTP protocol. You can also post articles to newsgroups by using
-(surprise!) the POST method.
-
-GET on newsgroups is not implemented yet.
-
-Examples:
-
- $req = HTTP::Request->new(GET => 'news:abc1234@a.sn.no');
-
- $req = HTTP::Request->new(POST => 'news:comp.lang.perl.test');
- $req->header(Subject => 'This is a test',
- From => 'me@some.where.org');
- $req->content(<<EOT);
- This is the content of the message that we are sending to
- the world.
- EOT
-
-
-=head2 Gopher Request
-
-The library supports the GET and HEAD methods for gopher requests. All
-request header values are ignored. HEAD cheats and returns a
-response without even talking to server.
-
-Gopher menus are always converted to HTML.
-
-The response "Content-Type" is generated from the document type
-encoded (as the first letter) in the request URL path itself.
-
-Example:
-
- $req = HTTP::Request->new(GET => 'gopher://gopher.sn.no/');
-
-
-
-=head2 File Request
-
-The library supports GET and HEAD methods for file requests. The
-"If-Modified-Since" header is supported. All other headers are
-ignored. The I<host> component of the file URL must be empty or set
-to "localhost". Any other I<host> value will be treated as an error.
-
-Directories are always converted to an HTML document. For normal
-files, the "Content-Type" and "Content-Encoding" in the response are
-guessed based on the file suffix.
-
-Example:
-
- $req = HTTP::Request->new(GET => 'file:/etc/passwd');
-
-
-=head2 Mailto Request
-
-You can send (aka "POST") mail messages using the library. All
-headers specified for the request are passed on to the mail system.
-The "To" header is initialized from the mail address in the URL.
-
-Example:
-
- $req = HTTP::Request->new(POST => 'mailto:libwww@perl.org');
- $req->header(Subject => "subscribe");
- $req->content("Please subscribe me to the libwww-perl mailing list!\n");
-
-=head2 CPAN Requests
-
-URLs with scheme C<cpan:> are redirected to a suitable CPAN
-mirror. If you have your own local mirror of CPAN you might tell LWP
-to use it for C<cpan:> URLs by an assignment like this:
-
- $LWP::Protocol::cpan::CPAN = "file:/local/CPAN/";
-
-Suitable CPAN mirrors are also picked up from the configuration for
-the CPAN.pm, so if you have used that module a suitable mirror should
-be picked automatically. If neither of these apply, then a redirect
-to the generic CPAN http location is issued.
-
-Example request to download the newest perl:
-
- $req = HTTP::Request->new(GET => "cpan:src/latest.tar.gz");
-
-
-=head1 OVERVIEW OF CLASSES AND PACKAGES
-
-This table should give you a quick overview of the classes provided by the
-library. Indentation shows class inheritance.
-
- LWP::MemberMixin -- Access to member variables of Perl5 classes
- LWP::UserAgent -- WWW user agent class
- LWP::RobotUA -- When developing a robot applications
- LWP::Protocol -- Interface to various protocol schemes
- LWP::Protocol::http -- http:// access
- LWP::Protocol::file -- file:// access
- LWP::Protocol::ftp -- ftp:// access
- ...
-
- LWP::Authen::Basic -- Handle 401 and 407 responses
- LWP::Authen::Digest
-
- HTTP::Headers -- MIME/RFC822 style header (used by HTTP::Message)
- HTTP::Message -- HTTP style message
- HTTP::Request -- HTTP request
- HTTP::Response -- HTTP response
- HTTP::Daemon -- A HTTP server class
-
- WWW::RobotRules -- Parse robots.txt files
- WWW::RobotRules::AnyDBM_File -- Persistent RobotRules
-
- Net::HTTP -- Low level HTTP client
-
-The following modules provide various functions and definitions.
-
- LWP -- This file. Library version number and documentation.
- LWP::MediaTypes -- MIME types configuration (text/html etc.)
- LWP::Simple -- Simplified procedural interface for common functions
- HTTP::Status -- HTTP status code (200 OK etc)
- HTTP::Date -- Date parsing module for HTTP date formats
- HTTP::Negotiate -- HTTP content negotiation calculation
- File::Listing -- Parse directory listings
- HTML::Form -- Processing for <form>s in HTML documents
-
-
-=head1 MORE DOCUMENTATION
-
-All modules contain detailed information on the interfaces they
-provide. The L<lwpcook> manpage is the libwww-perl cookbook that contain
-examples of typical usage of the library. You might want to take a
-look at how the scripts L<lwp-request>, L<lwp-download>, L<lwp-dump>
-and L<lwp-mirror> are implemented.
-
-=head1 ENVIRONMENT
-
-The following environment variables are used by LWP:
-
-=over
-
-=item HOME
-
-The L<LWP::MediaTypes> functions will look for the F<.media.types> and
-F<.mime.types> files relative to you home directory.
-
-=item http_proxy
-
-=item ftp_proxy
-
-=item xxx_proxy
-
-=item no_proxy
-
-These environment variables can be set to enable communication through
-a proxy server. See the description of the C<env_proxy> method in
-L<LWP::UserAgent>.
-
-=item PERL_LWP_ENV_PROXY
-
-If set to a TRUE value, then the L<LWP::UserAgent> will by default call
-C<env_proxy> during initialization. This makes LWP honor the proxy variables
-described above.
-
-=item PERL_LWP_SSL_VERIFY_HOSTNAME
-
-The default C<verify_hostname> setting for L<LWP::UserAgent>. If
-not set the default will be 1. Set it as 0 to disable hostname
-verification (the default prior to libwww-perl 5.840.
-
-=item PERL_LWP_SSL_CA_FILE
-
-=item PERL_LWP_SSL_CA_PATH
-
-The file and/or directory
-where the trusted Certificate Authority certificates
-is located. See L<LWP::UserAgent> for details.
-
-=item PERL_HTTP_URI_CLASS
-
-Used to decide what URI objects to instantiate. The default is L<URI>.
-You might want to set it to L<URI::URL> for compatibility with old times.
-
-=back
-
-=head1 AUTHORS
-
-LWP was made possible by contributions from Adam Newby, Albert
-Dvornik, Alexandre Duret-Lutz, Andreas Gustafsson, Andreas König,
-Andrew Pimlott, Andy Lester, Ben Coleman, Benjamin Low, Ben Low, Ben
-Tilly, Blair Zajac, Bob Dalgleish, BooK, Brad Hughes, Brian
-J. Murrell, Brian McCauley, Charles C. Fu, Charles Lane, Chris Nandor,
-Christian Gilmore, Chris W. Unger, Craig Macdonald, Dale Couch, Dan
-Kubb, Dave Dunkin, Dave W. Smith, David Coppit, David Dick, David
-D. Kilzer, Doug MacEachern, Edward Avis, erik, Gary Shea, Gisle Aas,
-Graham Barr, Gurusamy Sarathy, Hans de Graaff, Harald Joerg, Harry
-Bochner, Hugo, Ilya Zakharevich, INOUE Yoshinari, Ivan Panchenko, Jack
-Shirazi, James Tillman, Jan Dubois, Jared Rhine, Jim Stern, Joao
-Lopes, John Klar, Johnny Lee, Josh Kronengold, Josh Rai, Joshua
-Chamas, Joshua Hoblitt, Kartik Subbarao, Keiichiro Nagano, Ken
-Williams, KONISHI Katsuhiro, Lee T Lindley, Liam Quinn, Marc Hedlund,
-Marc Langheinrich, Mark D. Anderson, Marko Asplund, Mark Stosberg,
-Markus B Krüger, Markus Laker, Martijn Koster, Martin Thurn, Matthew
-Eldridge, Matthew.van.Eerde, Matt Sergeant, Michael A. Chase, Michael
-Quaranta, Michael Thompson, Mike Schilli, Moshe Kaminsky, Nathan
-Torkington, Nicolai Langfeldt, Norton Allen, Olly Betts, Paul
-J. Schinder, peterm, Philip Guenther, Daniel Buenzli, Pon Hwa Lin,
-Radoslaw Zielinski, Radu Greab, Randal L. Schwartz, Richard Chen,
-Robin Barker, Roy Fielding, Sander van Zoest, Sean M. Burke,
-shildreth, Slaven Rezic, Steve A Fink, Steve Hay, Steven Butler,
-Steve_Kilbane, Takanori Ugai, Thomas Lotterer, Tim Bunce, Tom Hughes,
-Tony Finch, Ville Skyttä, Ward Vandewege, William York, Yale Huang,
-and Yitzchak Scott-Thoennes.
-
-LWP owes a lot in motivation, design, and code, to the libwww-perl
-library for Perl4 by Roy Fielding, which included work from Alberto
-Accomazzi, James Casey, Brooks Cutter, Martijn Koster, Oscar
-Nierstrasz, Mel Melchner, Gertjan van Oosten, Jared Rhine, Jack
-Shirazi, Gene Spafford, Marc VanHeyningen, Steven E. Brenner, Marion
-Hakanson, Waldemar Kebsch, Tony Sanders, and Larry Wall; see the
-libwww-perl-0.40 library for details.
-
-=head1 COPYRIGHT
-
- Copyright 1995-2009, Gisle Aas
- Copyright 1995, Martijn Koster
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=head1 AVAILABILITY
-
-The latest version of this library is likely to be available from CPAN
-as well as:
-
- http://github.com/libwww-perl/libwww-perl
-
-The best place to discuss this code is on the <libwww@perl.org>
-mailing list.
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm
deleted file mode 100644
index 6af1441bdd..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm
+++ /dev/null
@@ -1,86 +0,0 @@
-package LWP::Authen::Basic;
-
-use strict;
-
-our $VERSION = '6.61';
-
-require Encode;
-require MIME::Base64;
-
-sub auth_header {
- my($class, $user, $pass, $request, $ua, $h) = @_;
-
- my $userpass = "$user:$pass";
- # https://tools.ietf.org/html/rfc7617#section-2.1
- my $charset = uc($h->{auth_param}->{charset} || "");
- $userpass = Encode::encode($charset, $userpass)
- if ($charset eq "UTF-8");
-
- return "Basic " . MIME::Base64::encode($userpass, "");
-}
-
-sub _reauth_requested {
- return 0;
-}
-
-sub authenticate
-{
- my($class, $ua, $proxy, $auth_param, $response,
- $request, $arg, $size) = @_;
-
- my $realm = $auth_param->{realm} || "";
- my $url = $proxy ? $request->{proxy} : $request->uri_canonical;
- return $response unless $url;
- my $host_port = $url->host_port;
- my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
-
- my @m = $proxy ? (m_proxy => $url) : (m_host_port => $host_port);
- push(@m, realm => $realm);
-
- my $h = $ua->get_my_handler("request_prepare", @m, sub {
- $_[0]{callback} = sub {
- my($req, $ua, $h) = @_;
- my($user, $pass) = $ua->credentials($host_port, $h->{realm});
- if (defined $user) {
- my $auth_value = $class->auth_header($user, $pass, $req, $ua, $h);
- $req->header($auth_header => $auth_value);
- }
- };
- });
- $h->{auth_param} = $auth_param;
-
- my $reauth_requested
- = $class->_reauth_requested($auth_param, $ua, $request, $auth_header);
- if ( !$proxy
- && (!$request->header($auth_header) || $reauth_requested)
- && $ua->credentials($host_port, $realm))
- {
- # we can make sure this handler applies and retry
- add_path($h, $url->path)
- unless $reauth_requested; # Do not clobber up path list for retries
- return $ua->request($request->clone, $arg, $size, $response);
- }
-
- my($user, $pass) = $ua->get_basic_credentials($realm, $url, $proxy);
- unless (defined $user and defined $pass) {
- $ua->set_my_handler("request_prepare", undef, @m); # delete handler
- return $response;
- }
-
- # check that the password has changed
- my ($olduser, $oldpass) = $ua->credentials($host_port, $realm);
- return $response if (defined $olduser and defined $oldpass and
- $user eq $olduser and $pass eq $oldpass);
-
- $ua->credentials($host_port, $realm, $user, $pass);
- add_path($h, $url->path) unless $proxy;
- return $ua->request($request->clone, $arg, $size, $response);
-}
-
-sub add_path {
- my($h, $path) = @_;
- $path =~ s,[^/]+\z,,;
- push(@{$h->{m_path_prefix}}, $path);
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm
deleted file mode 100644
index bb1d9ae3c8..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm
+++ /dev/null
@@ -1,80 +0,0 @@
-package LWP::Authen::Digest;
-
-use strict;
-use parent 'LWP::Authen::Basic';
-
-our $VERSION = '6.61';
-
-require Digest::MD5;
-
-sub _reauth_requested {
- my ($class, $auth_param, $ua, $request, $auth_header) = @_;
- my $ret = defined($$auth_param{stale}) && lc($$auth_param{stale}) eq 'true';
- if ($ret) {
- my $hdr = $request->header($auth_header);
- $hdr =~ tr/,/;/; # "," is used to separate auth-params!!
- ($hdr) = HTTP::Headers::Util::split_header_words($hdr);
- my $nonce = {@$hdr}->{nonce};
- delete $$ua{authen_md5_nonce_count}{$nonce};
- }
- return $ret;
-}
-
-sub auth_header {
- my($class, $user, $pass, $request, $ua, $h) = @_;
-
- my $auth_param = $h->{auth_param};
-
- my $nc = sprintf "%08X", ++$ua->{authen_md5_nonce_count}{$auth_param->{nonce}};
- my $cnonce = sprintf "%8x", time;
-
- my $uri = $request->uri->path_query;
- $uri = "/" unless length $uri;
-
- my $md5 = Digest::MD5->new;
-
- my(@digest);
- $md5->add(join(":", $user, $auth_param->{realm}, $pass));
- push(@digest, $md5->hexdigest);
- $md5->reset;
-
- push(@digest, $auth_param->{nonce});
-
- if ($auth_param->{qop}) {
- push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop});
- }
-
- $md5->add(join(":", $request->method, $uri));
- push(@digest, $md5->hexdigest);
- $md5->reset;
-
- $md5->add(join(":", @digest));
- my($digest) = $md5->hexdigest;
- $md5->reset;
-
- my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque);
- @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5");
-
- if (($auth_param->{qop} || "") =~ m|^auth([,;]auth-int)?$|) {
- @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc);
- }
-
- my(@order) = qw(username realm qop algorithm uri nonce nc cnonce response opaque);
- my @pairs;
- for (@order) {
- next unless defined $resp{$_};
-
- # RFC2617 says that qop-value and nc-value should be unquoted.
- if ( $_ eq 'qop' || $_ eq 'nc' ) {
- push(@pairs, "$_=" . $resp{$_});
- }
- else {
- push(@pairs, "$_=" . qq("$resp{$_}"));
- }
- }
-
- my $auth_value = "Digest " . join(", ", @pairs);
- return $auth_value;
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm
deleted file mode 100644
index de745af6ac..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm
+++ /dev/null
@@ -1,183 +0,0 @@
-package LWP::Authen::Ntlm;
-
-use strict;
-
-our $VERSION = '6.61';
-
-use Authen::NTLM "1.02";
-use MIME::Base64 "2.12";
-
-sub authenticate {
- my($class, $ua, $proxy, $auth_param, $response,
- $request, $arg, $size) = @_;
-
- my($user, $pass) = $ua->get_basic_credentials($auth_param->{realm},
- $request->uri, $proxy);
-
- unless(defined $user and defined $pass) {
- return $response;
- }
-
- if (!$ua->conn_cache()) {
- warn "The keep_alive option must be enabled for NTLM authentication to work. NTLM authentication aborted.\n";
- return $response;
- }
-
- my($domain, $username) = split(/\\/, $user);
-
- ntlm_domain($domain);
- ntlm_user($username);
- ntlm_password($pass);
-
- my $auth_header = $proxy ? "Proxy-Authorization" : "Authorization";
-
- # my ($challenge) = $response->header('WWW-Authenticate');
- my $challenge;
- foreach ($response->header('WWW-Authenticate')) {
- last if /^NTLM/ && ($challenge=$_);
- }
-
- if ($challenge eq 'NTLM') {
- # First phase, send handshake
- my $auth_value = "NTLM " . ntlm();
- ntlm_reset();
-
- # Need to check this isn't a repeated fail!
- my $r = $response;
- my $retry_count = 0;
- while ($r) {
- my $auth = $r->request->header($auth_header);
- ++$retry_count if ($auth && $auth eq $auth_value);
- if ($retry_count > 2) {
- # here we know this failed before
- $response->header("Client-Warning" =>
- "Credentials for '$user' failed before");
- return $response;
- }
- $r = $r->previous;
- }
-
- my $referral = $request->clone;
- $referral->header($auth_header => $auth_value);
- return $ua->request($referral, $arg, $size, $response);
- }
-
- else {
- # Second phase, use the response challenge (unless non-401 code
- # was returned, in which case, we just send back the response
- # object, as is
- my $auth_value;
- if ($response->code ne '401') {
- return $response;
- }
- else {
- my $challenge;
- foreach ($response->header('WWW-Authenticate')) {
- last if /^NTLM/ && ($challenge=$_);
- }
- $challenge =~ s/^NTLM //;
- ntlm();
- $auth_value = "NTLM " . ntlm($challenge);
- ntlm_reset();
- }
-
- my $referral = $request->clone;
- $referral->header($auth_header => $auth_value);
- my $response2 = $ua->request($referral, $arg, $size, $response);
- return $response2;
- }
-}
-
-1;
-__END__
-
-=pod
-
-=head1 NAME
-
-LWP::Authen::Ntlm - Library for enabling NTLM authentication (Microsoft) in LWP
-
-=head1 SYNOPSIS
-
- use LWP::UserAgent;
- use HTTP::Request::Common;
- my $url = 'http://www.company.com/protected_page.html';
-
- # Set up the ntlm client and then the base64 encoded ntlm handshake message
- my $ua = LWP::UserAgent->new(keep_alive=>1);
- $ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword');
-
- $request = GET $url;
- print "--Performing request now...-----------\n";
- $response = $ua->request($request);
- print "--Done with request-------------------\n";
-
- if ($response->is_success) {print "It worked!->" . $response->code . "\n"}
- else {print "It didn't work!->" . $response->code . "\n"}
-
-=head1 DESCRIPTION
-
-L<LWP::Authen::Ntlm> allows LWP to authenticate against servers that are using the
-NTLM authentication scheme popularized by Microsoft. This type of authentication is
-common on intranets of Microsoft-centric organizations.
-
-The module takes advantage of the Authen::NTLM module by Mark Bush. Since there
-is also another Authen::NTLM module available from CPAN by Yee Man Chan with an
-entirely different interface, it is necessary to ensure that you have the correct
-NTLM module.
-
-In addition, there have been problems with incompatibilities between different
-versions of L<Mime::Base64>, which Bush's L<Authen::NTLM> makes use of. Therefore, it is
-necessary to ensure that your Mime::Base64 module supports exporting of the
-C<encode_base64> and C<decode_base64> functions.
-
-=head1 USAGE
-
-The module is used indirectly through LWP, rather than including it directly in your
-code. The LWP system will invoke the NTLM authentication when it encounters the
-authentication scheme while attempting to retrieve a URL from a server. In order
-for the NTLM authentication to work, you must have a few things set up in your
-code prior to attempting to retrieve the URL:
-
-=over 4
-
-=item *
-
-Enable persistent HTTP connections
-
-To do this, pass the C<< "keep_alive=>1" >> option to the L<LWP::UserAgent> when creating it, like this:
-
- my $ua = LWP::UserAgent->new(keep_alive=>1);
-
-=item *
-
-Set the credentials on the UserAgent object
-
-The credentials must be set like this:
-
- $ua->credentials('www.company.com:80', '', "MyDomain\\MyUserCode", 'MyPassword');
-
-Note that you cannot use the L<HTTP::Request> object's C<authorization_basic()> method to set
-the credentials. Note, too, that the C<'www.company.com:80'> portion only sets credentials
-on the specified port AND it is case-sensitive (this is due to the way LWP is coded, and
-has nothing to do with LWP::Authen::Ntlm)
-
-=back
-
-=head1 AVAILABILITY
-
-General queries regarding LWP should be made to the LWP Mailing List.
-
-Questions specific to LWP::Authen::Ntlm can be forwarded to jtillman@bigfoot.com
-
-=head1 COPYRIGHT
-
-Copyright (c) 2002 James Tillman. All rights reserved. This
-program is free software; you can redistribute it and/or modify it
-under the same terms as Perl itself.
-
-=head1 SEE ALSO
-
-L<LWP>, L<LWP::UserAgent>, L<lwpcook>.
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/ConnCache.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/ConnCache.pm
deleted file mode 100644
index 67dfff6f6c..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/ConnCache.pm
+++ /dev/null
@@ -1,350 +0,0 @@
-package LWP::ConnCache;
-
-use strict;
-
-our $VERSION = '6.61';
-our $DEBUG;
-
-sub new {
- my($class, %cnf) = @_;
-
- my $total_capacity = 1;
- if (exists $cnf{total_capacity}) {
- $total_capacity = delete $cnf{total_capacity};
- }
- if (%cnf && $^W) {
- require Carp;
- Carp::carp("Unrecognised options: @{[sort keys %cnf]}")
- }
- my $self = bless { cc_conns => [] }, $class;
- $self->total_capacity($total_capacity);
- $self;
-}
-
-
-sub deposit {
- my($self, $type, $key, $conn) = @_;
- push(@{$self->{cc_conns}}, [$conn, $type, $key, time]);
- $self->enforce_limits($type);
- return;
-}
-
-
-sub withdraw {
- my($self, $type, $key) = @_;
- my $conns = $self->{cc_conns};
- for my $i (0 .. @$conns - 1) {
- my $c = $conns->[$i];
- next unless $c->[1] eq $type && $c->[2] eq $key;
- splice(@$conns, $i, 1); # remove it
- return $c->[0];
- }
- return undef;
-}
-
-
-sub total_capacity {
- my $self = shift;
- my $old = $self->{cc_limit_total};
- if (@_) {
- $self->{cc_limit_total} = shift;
- $self->enforce_limits;
- }
- $old;
-}
-
-
-sub capacity {
- my $self = shift;
- my $type = shift;
- my $old = $self->{cc_limit}{$type};
- if (@_) {
- $self->{cc_limit}{$type} = shift;
- $self->enforce_limits($type);
- }
- $old;
-}
-
-
-sub enforce_limits {
- my($self, $type) = @_;
- my $conns = $self->{cc_conns};
-
- my @types = $type ? ($type) : ($self->get_types);
- for $type (@types) {
- next unless $self->{cc_limit};
- my $limit = $self->{cc_limit}{$type};
- next unless defined $limit;
- for my $i (reverse 0 .. @$conns - 1) {
- next unless $conns->[$i][1] eq $type;
- if (--$limit < 0) {
- $self->dropping(splice(@$conns, $i, 1), "$type capacity exceeded");
- }
- }
- }
-
- if (defined(my $total = $self->{cc_limit_total})) {
- while (@$conns > $total) {
- $self->dropping(shift(@$conns), "Total capacity exceeded");
- }
- }
-}
-
-
-sub dropping {
- my($self, $c, $reason) = @_;
- print "DROPPING @$c [$reason]\n" if $DEBUG;
-}
-
-
-sub drop {
- my($self, $checker, $reason) = @_;
- if (ref($checker) ne "CODE") {
- # make it so
- if (!defined $checker) {
- $checker = sub { 1 }; # drop all of them
- }
- elsif (_looks_like_number($checker)) {
- my $age_limit = $checker;
- my $time_limit = time - $age_limit;
- $reason ||= "older than $age_limit";
- $checker = sub { $_[3] < $time_limit };
- }
- else {
- my $type = $checker;
- $reason ||= "drop $type";
- $checker = sub { $_[1] eq $type }; # match on type
- }
- }
- $reason ||= "drop";
-
- local $SIG{__DIE__}; # don't interfere with eval below
- local $@;
- my @c;
- for (@{$self->{cc_conns}}) {
- my $drop;
- eval {
- if (&$checker(@$_)) {
- $self->dropping($_, $reason);
- $drop++;
- }
- };
- push(@c, $_) unless $drop;
- }
- @{$self->{cc_conns}} = @c;
-}
-
-
-sub prune {
- my $self = shift;
- $self->drop(sub { !shift->ping }, "ping");
-}
-
-
-sub get_types {
- my $self = shift;
- my %t;
- $t{$_->[1]}++ for @{$self->{cc_conns}};
- return keys %t;
-}
-
-
-sub get_connections {
- my($self, $type) = @_;
- my @c;
- for (@{$self->{cc_conns}}) {
- push(@c, $_->[0]) if !$type || ($type && $type eq $_->[1]);
- }
- @c;
-}
-
-
-sub _looks_like_number {
- $_[0] =~ /^([+-]?)(?=\d|\.\d)\d*(\.\d*)?([Ee]([+-]?\d+))?$/;
-}
-
-1;
-
-
-__END__
-
-=pod
-
-=head1 NAME
-
-LWP::ConnCache - Connection cache manager
-
-=head1 NOTE
-
-This module is experimental. Details of its interface is likely to
-change in the future.
-
-=head1 SYNOPSIS
-
- use LWP::ConnCache;
- my $cache = LWP::ConnCache->new;
- $cache->deposit($type, $key, $sock);
- $sock = $cache->withdraw($type, $key);
-
-=head1 DESCRIPTION
-
-The C<LWP::ConnCache> class is the standard connection cache manager
-for L<LWP::UserAgent>.
-
-=head1 METHODS
-
-The following basic methods are provided:
-
-=head2 new
-
- my $cache = LWP::ConnCache->new( %options )
-
-This method constructs a new L<LWP::ConnCache> object. The only
-option currently accepted is C<total_capacity>. If specified it
-initializes the L<LWP::ConnCache/total_capacity> option. It defaults to C<1>.
-
-=head2 total_capacity
-
- my $cap = $cache->total_capacity;
- $cache->total_capacity(0); # drop all immediately
- $cache->total_capacity(undef); # no limit
- $cache->total_capacity($number);
-
-Get/sets the number of connection that will be cached. Connections
-will start to be dropped when this limit is reached. If set to C<0>,
-then all connections are immediately dropped. If set to C<undef>,
-then there is no limit.
-
-=head2 capacity
-
- my $http_capacity = $cache->capacity('http');
- $cache->capacity('http', 2 );
-
-Get/set a limit for the number of connections of the specified type
-that can be cached. The first parameter is a short string like
-C<"http"> or C<"ftp">.
-
-=head2 drop
-
- $cache->drop(); # Drop ALL connections
- # which is just a synonym for:
- $cache->drop(sub{1}); # Drop ALL connections
- # drop all connections older than 22 seconds and add a reason for it!
- $cache->drop(22, "Older than 22 secs dropped");
- # which is just a synonym for:
- $cache->drop(sub {
- my ($conn, $type, $key, $deposit_time) = @_;
- if ($deposit_time < 22) {
- # true values drop the connection
- return 1;
- }
- # false values don't drop the connection
- return 0;
- }, "Older than 22 secs dropped" );
-
-Drop connections by some criteria. The $checker argument is a
-subroutine that is called for each connection. If the routine returns
-a TRUE value then the connection is dropped. The routine is called
-with C<($conn, $type, $key, $deposit_time)> as arguments.
-
-Shortcuts: If the C<$checker> argument is absent (or C<undef>) all cached
-connections are dropped. If the $checker is a number then all
-connections untouched that the given number of seconds or more are
-dropped. If $checker is a string then all connections of the given
-type are dropped.
-
-The C<reason> is passed on to the L<LWP::ConnCache/dropped> method.
-
-=head2 prune
-
- $cache->prune();
-
-Calling this method will drop all connections that are dead. This is
-tested by calling the L<LWP::ConnCache/ping> method on the connections. If
-the L<LWP::ConnCache/ping> method exists and returns a false value, then the
-connection is dropped.
-
-=head2 get_types
-
- my @types = $cache->get_types();
-
-This returns all the C<type> fields used for the currently cached
-connections.
-
-=head2 get_connections
-
- my @conns = $cache->get_connections(); # all connections
- my @conns = $cache->get_connections('http'); # connections for http
-
-This returns all connection objects of the specified type. If no type
-is specified then all connections are returned. In scalar context the
-number of cached connections of the specified type is returned.
-
-=head1 PROTOCOL METHODS
-
-The following methods are called by low-level protocol modules to
-try to save away connections and to get them back.
-
-=head2 deposit
-
- $cache->deposit($type, $key, $conn);
-
-This method adds a new connection to the cache. As a result, other
-already cached connections might be dropped. Multiple connections with
-the same type/key might be added.
-
-=head2 withdraw
-
- my $conn = $cache->withdraw($type, $key);
-
-This method tries to fetch back a connection that was previously
-deposited. If no cached connection with the specified $type/$key is
-found, then C<undef> is returned. There is not guarantee that a
-deposited connection can be withdrawn, as the cache manger is free to
-drop connections at any time.
-
-=head1 INTERNAL METHODS
-
-The following methods are called internally. Subclasses might want to
-override them.
-
-=head2 enforce_limits
-
- $conn->enforce_limits([$type])
-
-This method is called with after a new connection is added (deposited)
-in the cache or capacity limits are adjusted. The default
-implementation drops connections until the specified capacity limits
-are not exceeded.
-
-=head2 dropping
-
- $conn->dropping($conn_record, $reason)
-
-This method is called when a connection is dropped. The record
-belonging to the dropped connection is passed as the first argument
-and a string describing the reason for the drop is passed as the
-second argument. The default implementation makes some noise if the
-C<$LWP::ConnCache::DEBUG> variable is set and nothing more.
-
-=head1 SUBCLASSING
-
-For specialized cache policy it makes sense to subclass
-C<LWP::ConnCache> and perhaps override the L<LWP::ConnCache/deposit>,
-L<LWP::ConnCache/enforce_limits>, and L<LWP::ConnCache/dropping> methods.
-
-The object itself is a hash. Keys prefixed with C<cc_> are reserved
-for the base class.
-
-=head1 SEE ALSO
-
-L<LWP::UserAgent>
-
-=head1 COPYRIGHT
-
-Copyright 2001 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug.pm
deleted file mode 100644
index 1e2ea15d53..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug.pm
+++ /dev/null
@@ -1,112 +0,0 @@
-package LWP::Debug; # legacy
-
-our $VERSION = '6.61';
-
-require Exporter;
-our @ISA = qw(Exporter);
-our @EXPORT_OK = qw(level trace debug conns);
-
-use Carp ();
-
-my @levels = qw(trace debug conns);
-our %current_level = ();
-
-sub import {
- my $pack = shift;
- my $callpkg = caller(0);
- my @symbols = ();
- my @levels = ();
- for (@_) {
- if (/^[-+]/) {
- push(@levels, $_);
- }
- else {
- push(@symbols, $_);
- }
- }
- Exporter::export($pack, $callpkg, @symbols);
- level(@levels);
-}
-
-sub level {
- for (@_) {
- if ($_ eq '+') { # all on
- # switch on all levels
- %current_level = map { $_ => 1 } @levels;
- }
- elsif ($_ eq '-') { # all off
- %current_level = ();
- }
- elsif (/^([-+])(\w+)$/) {
- $current_level{$2} = $1 eq '+';
- }
- else {
- Carp::croak("Illegal level format $_");
- }
- }
-}
-
-sub trace { _log(@_) if $current_level{'trace'}; }
-sub debug { _log(@_) if $current_level{'debug'}; }
-sub conns { _log(@_) if $current_level{'conns'}; }
-
-sub _log {
- my $msg = shift;
- $msg .= "\n" unless $msg =~ /\n$/; # ensure trailing "\n"
-
- my ($package, $filename, $line, $sub) = caller(2);
- print STDERR "$sub: $msg";
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-LWP::Debug - deprecated
-
-=head1 DESCRIPTION
-
-This module has been deprecated. Please see L<LWP::ConsoleLogger> for your
-debugging needs.
-
-LWP::Debug is used to provide tracing facilities, but these are not used
-by LWP any more. The code in this module is kept around
-(undocumented) so that 3rd party code that happens to use the old
-interfaces continue to run.
-
-One useful feature that LWP::Debug provided (in an imprecise and
-troublesome way) was network traffic monitoring. The following
-section provides some hints about recommended replacements.
-
-=head2 Network traffic monitoring
-
-The best way to monitor the network traffic that LWP generates is to
-use an external TCP monitoring program. The
-L<WireShark|http://www.wireshark.org/> program is highly recommended for this.
-
-Another approach it to use a debugging HTTP proxy server and make
-LWP direct all its traffic via this one. Call C<< $ua->proxy >> to
-set it up and then just use LWP as before.
-
-For less precise monitoring needs just setting up a few simple
-handlers might do. The following example sets up handlers to dump the
-request and response objects that pass through LWP:
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
- $ua->default_header('Accept-Encoding' => scalar HTTP::Message::decodable());
-
- $ua->add_handler("request_send", sub { shift->dump; return });
- $ua->add_handler("response_done", sub { shift->dump; return });
-
- $ua->get("http://www.example.com");
-
-=head1 SEE ALSO
-
-L<LWP::ConsoleLogger>, L<LWP::ConsoleLogger::Everywhere>, L<LWP::UserAgent>
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug/TraceHTTP.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug/TraceHTTP.pm
deleted file mode 100644
index a6cd44cbea..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug/TraceHTTP.pm
+++ /dev/null
@@ -1,29 +0,0 @@
-package LWP::Debug::TraceHTTP;
-
-# Just call:
-#
-# require LWP::Debug::TraceHTTP;
-# LWP::Protocol::implementor('http', 'LWP::Debug::TraceHTTP');
-#
-# to use this module to trace all calls to the HTTP socket object in
-# programs that use LWP.
-
-use strict;
-use parent 'LWP::Protocol::http';
-
-our $VERSION = '6.61';
-
-package # hide from PAUSE
- LWP::Debug::TraceHTTP::Socket;
-
-use Data::Dump 1.13;
-use Data::Dump::Trace qw(autowrap mcall);
-
-autowrap("LWP::Protocol::http::Socket" => "sock");
-
-sub new {
- my $class = shift;
- return mcall("LWP::Protocol::http::Socket" => "new", undef, @_);
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/DebugFile.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/DebugFile.pm
deleted file mode 100644
index 27f3dbb228..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/DebugFile.pm
+++ /dev/null
@@ -1,7 +0,0 @@
-package LWP::DebugFile;
-
-our $VERSION = '6.61';
-
-# legacy stub
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MemberMixin.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MemberMixin.pm
deleted file mode 100644
index a5a9e7599b..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MemberMixin.pm
+++ /dev/null
@@ -1,48 +0,0 @@
-package LWP::MemberMixin;
-
-our $VERSION = '6.61';
-
-sub _elem {
- my $self = shift;
- my $elem = shift;
- my $old = $self->{$elem};
- $self->{$elem} = shift if @_;
- return $old;
-}
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-LWP::MemberMixin - Member access mixin class
-
-=head1 SYNOPSIS
-
- package Foo;
- use parent qw(LWP::MemberMixin);
-
-=head1 DESCRIPTION
-
-A mixin class to get methods that provide easy access to member
-variables in the C<%$self>.
-Ideally there should be better Perl language support for this.
-
-=head1 METHODS
-
-There is only one method provided:
-
-=head2 _elem
-
- _elem($elem [, $val])
-
-Internal method to get/set the value of member variable
-C<$elem>. If C<$val> is present it is used as the new value
-for the member variable. If it is not present the current
-value is not touched. In both cases the previous value of
-the member variable is returned.
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol.pm
deleted file mode 100644
index 1d656cf850..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol.pm
+++ /dev/null
@@ -1,313 +0,0 @@
-package LWP::Protocol;
-
-use parent 'LWP::MemberMixin';
-
-our $VERSION = '6.61';
-
-use strict;
-use Carp ();
-use HTTP::Status ();
-use HTTP::Response ();
-use Try::Tiny qw(try catch);
-
-my %ImplementedBy = (); # scheme => classname
-
-sub new
-{
- my($class, $scheme, $ua) = @_;
-
- my $self = bless {
- scheme => $scheme,
- ua => $ua,
-
- # historical/redundant
- max_size => $ua->{max_size},
- }, $class;
-
- $self;
-}
-
-
-sub create
-{
- my($scheme, $ua) = @_;
- my $impclass = LWP::Protocol::implementor($scheme) or
- Carp::croak("Protocol scheme '$scheme' is not supported");
-
- # hand-off to scheme specific implementation sub-class
- my $protocol = $impclass->new($scheme, $ua);
-
- return $protocol;
-}
-
-
-sub implementor
-{
- my($scheme, $impclass) = @_;
-
- if ($impclass) {
- $ImplementedBy{$scheme} = $impclass;
- }
- my $ic = $ImplementedBy{$scheme};
- return $ic if $ic;
-
- return '' unless $scheme =~ /^([.+\-\w]+)$/; # check valid URL schemes
- $scheme = $1; # untaint
- $scheme =~ tr/.+-/_/; # make it a legal module name
-
- # scheme not yet known, look for a 'use'd implementation
- $ic = "LWP::Protocol::$scheme"; # default location
- $ic = "LWP::Protocol::nntp" if $scheme eq 'news'; #XXX ugly hack
- no strict 'refs';
- # check we actually have one for the scheme:
- unless (@{"${ic}::ISA"}) {
- # try to autoload it
- try {
- (my $class = $ic) =~ s{::}{/}g;
- $class .= '.pm' unless $class =~ /\.pm$/;
- require $class;
- }
- catch {
- my $error = $_;
- if ($error =~ /Can't locate/) {
- $ic = '';
- }
- else {
- die "$error\n";
- }
- };
- }
- $ImplementedBy{$scheme} = $ic if $ic;
- $ic;
-}
-
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size, $timeout) = @_;
- Carp::croak('LWP::Protocol::request() needs to be overridden in subclasses');
-}
-
-
-# legacy
-sub timeout { shift->_elem('timeout', @_); }
-sub max_size { shift->_elem('max_size', @_); }
-
-
-sub collect
-{
- my ($self, $arg, $response, $collector) = @_;
- my $content;
- my($ua, $max_size) = @{$self}{qw(ua max_size)};
-
- # This can't be moved to Try::Tiny due to the closures within causing
- # leaks on any version of Perl prior to 5.18.
- # https://perl5.git.perl.org/perl.git/commitdiff/a0d2bbd5c
- my $error = do { #catch
- local $@;
- local $\; # protect the print below from surprises
- eval { # try
- if (!defined($arg) || !$response->is_success) {
- $response->{default_add_content} = 1;
- }
- elsif (!ref($arg) && length($arg)) {
- open(my $fh, ">", $arg) or die "Can't write to '$arg': $!";
- binmode($fh);
- push(@{$response->{handlers}{response_data}}, {
- callback => sub {
- print $fh $_[3] or die "Can't write to '$arg': $!";
- 1;
- },
- });
- push(@{$response->{handlers}{response_done}}, {
- callback => sub {
- close($fh) or die "Can't write to '$arg': $!";
- undef($fh);
- },
- });
- }
- elsif (ref($arg) eq 'CODE') {
- push(@{$response->{handlers}{response_data}}, {
- callback => sub {
- &$arg($_[3], $_[0], $self);
- 1;
- },
- });
- }
- else {
- die "Unexpected collect argument '$arg'";
- }
-
- $ua->run_handlers("response_header", $response);
-
- if (delete $response->{default_add_content}) {
- push(@{$response->{handlers}{response_data}}, {
- callback => sub {
- $_[0]->add_content($_[3]);
- 1;
- },
- });
- }
-
-
- my $content_size = 0;
- my $length = $response->content_length;
- my %skip_h;
-
- while ($content = &$collector, length $$content) {
- for my $h ($ua->handlers("response_data", $response)) {
- next if $skip_h{$h};
- unless ($h->{callback}->($response, $ua, $h, $$content)) {
- # XXX remove from $response->{handlers}{response_data} if present
- $skip_h{$h}++;
- }
- }
- $content_size += length($$content);
- $ua->progress(($length ? ($content_size / $length) : "tick"), $response);
- if (defined($max_size) && $content_size > $max_size) {
- $response->push_header("Client-Aborted", "max_size");
- last;
- }
- }
- 1;
- };
- $@;
- };
-
- if ($error) {
- chomp($error);
- $response->push_header('X-Died' => $error);
- $response->push_header("Client-Aborted", "die");
- };
- delete $response->{handlers}{response_data};
- delete $response->{handlers} unless %{$response->{handlers}};
- return $response;
-}
-
-
-sub collect_once
-{
- my($self, $arg, $response) = @_;
- my $content = \ $_[3];
- my $first = 1;
- $self->collect($arg, $response, sub {
- return $content if $first--;
- return \ "";
- });
-}
-
-1;
-
-
-__END__
-
-=pod
-
-=head1 NAME
-
-LWP::Protocol - Base class for LWP protocols
-
-=head1 SYNOPSIS
-
- package LWP::Protocol::foo;
- use parent qw(LWP::Protocol);
-
-=head1 DESCRIPTION
-
-This class is used as the base class for all protocol implementations
-supported by the LWP library.
-
-When creating an instance of this class using
-C<LWP::Protocol::create($url)>, and you get an initialized subclass
-appropriate for that access method. In other words, the
-L<LWP::Protocol/create> function calls the constructor for one of its
-subclasses.
-
-All derived C<LWP::Protocol> classes need to override the C<request()>
-method which is used to service a request. The overridden method can
-make use of the C<collect()> method to collect together chunks of data
-as it is received.
-
-=head1 METHODS
-
-The following methods and functions are provided:
-
-=head2 new
-
- my $prot = LWP::Protocol->new();
-
-The LWP::Protocol constructor is inherited by subclasses. As this is a
-virtual base class this method should B<not> be called directly.
-
-=head2 create
-
- my $prot = LWP::Protocol::create($scheme)
-
-Create an object of the class implementing the protocol to handle the
-given scheme. This is a function, not a method. It is more an object
-factory than a constructor. This is the function user agents should
-use to access protocols.
-
-=head2 implementor
-
- my $class = LWP::Protocol::implementor($scheme, [$class])
-
-Get and/or set implementor class for a scheme. Returns C<''> if the
-specified scheme is not supported.
-
-=head2 request
-
- $response = $protocol->request($request, $proxy, undef);
- $response = $protocol->request($request, $proxy, '/tmp/sss');
- $response = $protocol->request($request, $proxy, \&callback, 1024);
-
-Dispatches a request over the protocol, and returns a response
-object. This method needs to be overridden in subclasses. Refer to
-L<LWP::UserAgent> for description of the arguments.
-
-=head2 collect
-
- my $res = $prot->collect(undef, $response, $collector); # stored in $response
- my $res = $prot->collect($filename, $response, $collector);
- my $res = $prot->collect(sub { ... }, $response, $collector);
-
-Collect the content of a request, and process it appropriately into a scalar,
-file, or by calling a callback. If the first parameter is undefined, then the
-content is stored within the C<$response>. If it's a simple scalar, then it's
-interpreted as a file name and the content is written to this file. If it's a
-code reference, then content is passed to this routine.
-
-The collector is a routine that will be called and which is
-responsible for returning pieces (as ref to scalar) of the content to
-process. The C<$collector> signals C<EOF> by returning a reference to an
-empty string.
-
-The return value is the L<HTTP::Response> object reference.
-
-B<Note:> We will only use the callback or file argument if
-C<< $response->is_success() >>. This avoids sending content data for
-redirects and authentication responses to the callback which would be
-confusing.
-
-=head2 collect_once
-
- $prot->collect_once($arg, $response, $content)
-
-Can be called when the whole response content is available as content. This
-will invoke L<LWP::Protocol/collect> with a collector callback that
-returns a reference to C<$content> the first time and an empty string the
-next.
-
-=head1 SEE ALSO
-
-Inspect the F<LWP/Protocol/file.pm> and F<LWP/Protocol/http.pm> files
-for examples of usage.
-
-=head1 COPYRIGHT
-
-Copyright 1995-2001 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/cpan.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/cpan.pm
deleted file mode 100644
index 90ced43d06..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/cpan.pm
+++ /dev/null
@@ -1,72 +0,0 @@
-package LWP::Protocol::cpan;
-
-use strict;
-
-use parent qw(LWP::Protocol);
-
-our $VERSION = '6.61';
-
-require URI;
-require HTTP::Status;
-require HTTP::Response;
-
-our $CPAN;
-
-unless ($CPAN) {
- # Try to find local CPAN mirror via $CPAN::Config
- eval {
- require CPAN::Config;
- if($CPAN::Config) {
- my $urls = $CPAN::Config->{urllist};
- if (ref($urls) eq "ARRAY") {
- my $file;
- for (@$urls) {
- if (/^file:/) {
- $file = $_;
- last;
- }
- }
-
- if ($file) {
- $CPAN = $file;
- }
- else {
- $CPAN = $urls->[0];
- }
- }
- }
- };
-
- $CPAN ||= "http://cpan.org/"; # last resort
-}
-
-# ensure that we don't chop of last part
-$CPAN .= "/" unless $CPAN =~ m,/$,;
-
-
-sub request {
- my($self, $request, $proxy, $arg, $size) = @_;
- # check proxy
- if (defined $proxy)
- {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy with cpan');
- }
-
- # check method
- my $method = $request->method;
- unless ($method eq 'GET' || $method eq 'HEAD') {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'cpan:' URLs");
- }
-
- my $path = $request->uri->path;
- $path =~ s,^/,,;
-
- my $response = HTTP::Response->new(HTTP::Status::RC_FOUND);
- $response->header("Location" => URI->new_abs($path, $CPAN));
- $response;
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/data.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/data.pm
deleted file mode 100644
index a0461b5e41..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/data.pm
+++ /dev/null
@@ -1,52 +0,0 @@
-package LWP::Protocol::data;
-
-# Implements access to data:-URLs as specified in RFC 2397
-
-use strict;
-
-our $VERSION = '6.61';
-
-require HTTP::Response;
-require HTTP::Status;
-
-use parent qw(LWP::Protocol);
-
-use HTTP::Date qw(time2str);
-require LWP; # needs version number
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size) = @_;
-
- # check proxy
- if (defined $proxy)
- {
- return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy with data');
- }
-
- # check method
- my $method = $request->method;
- unless ($method eq 'GET' || $method eq 'HEAD') {
- return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'data:' URLs");
- }
-
- my $url = $request->uri;
- my $response = HTTP::Response->new( HTTP::Status::RC_OK, "Document follows");
-
- my $media_type = $url->media_type;
-
- my $data = $url->data;
- $response->header('Content-Type' => $media_type,
- 'Content-Length' => length($data),
- 'Date' => time2str(time),
- 'Server' => "libwww-perl-internal/$LWP::VERSION"
- );
-
- $data = "" if $method eq "HEAD";
- return $self->collect_once($arg, $response, $data);
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/file.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/file.pm
deleted file mode 100644
index 37be55d76f..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/file.pm
+++ /dev/null
@@ -1,147 +0,0 @@
-package LWP::Protocol::file;
-
-use parent qw(LWP::Protocol);
-
-use strict;
-
-our $VERSION = '6.61';
-
-require LWP::MediaTypes;
-require HTTP::Request;
-require HTTP::Response;
-require HTTP::Status;
-require HTTP::Date;
-
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size) = @_;
-
- $size = 4096 unless defined $size and $size > 0;
-
- # check proxy
- if (defined $proxy)
- {
- return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy through the filesystem');
- }
-
- # check method
- my $method = $request->method;
- unless ($method eq 'GET' || $method eq 'HEAD') {
- return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'file:' URLs");
- }
-
- # check url
- my $url = $request->uri;
-
- my $scheme = $url->scheme;
- if ($scheme ne 'file') {
- return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::file::request called for '$scheme'");
- }
-
- # URL OK, look at file
- my $path = $url->file;
-
- # test file exists and is readable
- unless (-e $path) {
- return HTTP::Response->new( HTTP::Status::RC_NOT_FOUND,
- "File `$path' does not exist");
- }
- unless (-r _) {
- return HTTP::Response->new( HTTP::Status::RC_FORBIDDEN,
- 'User does not have read permission');
- }
-
- # looks like file exists
- my($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$filesize,
- $atime,$mtime,$ctime,$blksize,$blocks)
- = stat(_);
-
- # XXX should check Accept headers?
-
- # check if-modified-since
- my $ims = $request->header('If-Modified-Since');
- if (defined $ims) {
- my $time = HTTP::Date::str2time($ims);
- if (defined $time and $time >= $mtime) {
- return HTTP::Response->new( HTTP::Status::RC_NOT_MODIFIED,
- "$method $path");
- }
- }
-
- # Ok, should be an OK response by now...
- my $response = HTTP::Response->new( HTTP::Status::RC_OK );
-
- # fill in response headers
- $response->header('Last-Modified', HTTP::Date::time2str($mtime));
-
- if (-d _) { # If the path is a directory, process it
- # generate the HTML for directory
- opendir(D, $path) or
- return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Cannot read directory '$path': $!");
- my(@files) = sort readdir(D);
- closedir(D);
-
- # Make directory listing
- require URI::Escape;
- require HTML::Entities;
- my $pathe = $path . ( $^O eq 'MacOS' ? ':' : '/');
- for (@files) {
- my $furl = URI::Escape::uri_escape($_);
- if ( -d "$pathe$_" ) {
- $furl .= '/';
- $_ .= '/';
- }
- my $desc = HTML::Entities::encode($_);
- $_ = qq{<LI><A HREF="$furl">$desc</A>};
- }
- # Ensure that the base URL is "/" terminated
- my $base = $url->clone;
- unless ($base->path =~ m|/$|) {
- $base->path($base->path . "/");
- }
- my $html = join("\n",
- "<HTML>\n<HEAD>",
- "<TITLE>Directory $path</TITLE>",
- "<BASE HREF=\"$base\">",
- "</HEAD>\n<BODY>",
- "<H1>Directory listing of $path</H1>",
- "<UL>", @files, "</UL>",
- "</BODY>\n</HTML>\n");
-
- $response->header('Content-Type', 'text/html');
- $response->header('Content-Length', length $html);
- $html = "" if $method eq "HEAD";
-
- return $self->collect_once($arg, $response, $html);
-
- }
-
- # path is a regular file
- $response->header('Content-Length', $filesize);
- LWP::MediaTypes::guess_media_type($path, $response);
-
- # read the file
- if ($method ne "HEAD") {
- open(my $fh, '<', $path) or return new
- HTTP::Response(HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Cannot read file '$path': $!");
- binmode($fh);
- $response = $self->collect($arg, $response, sub {
- my $content = "";
- my $bytes = sysread($fh, $content, $size);
- return \$content if $bytes > 0;
- return \ "";
- });
- close($fh);
- }
-
- $response;
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/ftp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/ftp.pm
deleted file mode 100644
index a82d527345..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/ftp.pm
+++ /dev/null
@@ -1,555 +0,0 @@
-package LWP::Protocol::ftp;
-
-# Implementation of the ftp protocol (RFC 959). We let the Net::FTP
-# package do all the dirty work.
-use parent qw(LWP::Protocol);
-use strict;
-
-our $VERSION = '6.61';
-
-use Carp ();
-use HTTP::Status ();
-use HTTP::Negotiate ();
-use HTTP::Response ();
-use LWP::MediaTypes ();
-use File::Listing ();
-
-
-{
-
- package # hide from PAUSE
- LWP::Protocol::MyFTP;
-
- use strict;
- use parent qw(Net::FTP);
-
- sub new {
- my $class = shift;
-
- my $self = $class->SUPER::new(@_) || return undef;
-
- my $mess = $self->message; # welcome message
- $mess =~ s|\n.*||s; # only first line left
- $mess =~ s|\s*ready\.?$||;
-
- # Make the version number more HTTP like
- $mess =~ s|\s*\(Version\s*|/| and $mess =~ s|\)$||;
- ${*$self}{myftp_server} = $mess;
-
- #$response->header("Server", $mess);
-
- $self;
- }
-
- sub http_server {
- my $self = shift;
- ${*$self}{myftp_server};
- }
-
- sub home {
- my $self = shift;
- my $old = ${*$self}{myftp_home};
- if (@_) {
- ${*$self}{myftp_home} = shift;
- }
- $old;
- }
-
- sub go_home {
- my $self = shift;
- $self->cwd(${*$self}{myftp_home});
- }
-
- sub request_count {
- my $self = shift;
- ++${*$self}{myftp_reqcount};
- }
-
- sub ping {
- my $self = shift;
- return $self->go_home;
- }
-}
-
-sub _connect {
- my ($self, $host, $port, $user, $account, $password, $timeout) = @_;
-
- my $key;
- my $conn_cache = $self->{ua}{conn_cache};
- if ($conn_cache) {
- $key = "$host:$port:$user";
- $key .= ":$account" if defined($account);
- if (my $ftp = $conn_cache->withdraw("ftp", $key)) {
- if ($ftp->ping) {
-
- # save it again
- $conn_cache->deposit("ftp", $key, $ftp);
- return $ftp;
- }
- }
- }
-
- # try to make a connection
- my $ftp = LWP::Protocol::MyFTP->new(
- $host,
- Port => $port,
- Timeout => $timeout,
- LocalAddr => $self->{ua}{local_address},
- );
-
- # XXX Should be some what to pass on 'Passive' (header??)
- unless ($ftp) {
- $@ =~ s/^Net::FTP: //;
- return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR, $@);
- }
-
- unless ($ftp->login($user, $password, $account)) {
-
- # Unauthorized. Let's fake a RC_UNAUTHORIZED response
- my $mess = scalar($ftp->message);
- $mess =~ s/\n$//;
- my $res = HTTP::Response->new(HTTP::Status::RC_UNAUTHORIZED, $mess);
- $res->header("Server", $ftp->http_server);
- $res->header("WWW-Authenticate", qq(Basic Realm="FTP login"));
- return $res;
- }
-
- my $home = $ftp->pwd;
- $ftp->home($home);
-
- $conn_cache->deposit("ftp", $key, $ftp) if $conn_cache;
-
- return $ftp;
-}
-
-
-sub request {
- my ($self, $request, $proxy, $arg, $size, $timeout) = @_;
-
- $size = 4096 unless $size;
-
- # check proxy
- if (defined $proxy) {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy through the ftp');
- }
-
- my $url = $request->uri;
- if ($url->scheme ne 'ftp') {
- my $scheme = $url->scheme;
- return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::ftp::request called for '$scheme'");
- }
-
- # check method
- my $method = $request->method;
-
- unless ($method eq 'GET' || $method eq 'HEAD' || $method eq 'PUT') {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' . "$method for 'ftp:' URLs");
- }
-
- my $host = $url->host;
- my $port = $url->port;
- my $user = $url->user;
- my $password = $url->password;
-
- # If a basic authorization header is present than we prefer these over
- # the username/password specified in the URL.
- {
- my ($u, $p) = $request->authorization_basic;
- if (defined $u) {
- $user = $u;
- $password = $p;
- }
- }
-
- # We allow the account to be specified in the "Account" header
- my $account = $request->header('Account');
-
- my $ftp
- = $self->_connect($host, $port, $user, $account, $password, $timeout);
- return $ftp if ref($ftp) eq "HTTP::Response"; # ugh!
-
- # Create an initial response object
- my $response = HTTP::Response->new(HTTP::Status::RC_OK, "OK");
- $response->header(Server => $ftp->http_server);
- $response->header('Client-Request-Num' => $ftp->request_count);
- $response->request($request);
-
- # Get & fix the path
- my @path = grep {length} $url->path_segments;
- my $remote_file = pop(@path);
- $remote_file = '' unless defined $remote_file;
-
- my $type;
- if (ref $remote_file) {
- my @params;
- ($remote_file, @params) = @$remote_file;
- for (@params) {
- $type = $_ if s/^type=//;
- }
- }
-
- if ($type && $type eq 'a') {
- $ftp->ascii;
- }
- else {
- $ftp->binary;
- }
-
- for (@path) {
- unless ($ftp->cwd($_)) {
- return HTTP::Response->new(HTTP::Status::RC_NOT_FOUND,
- "Can't chdir to $_");
- }
- }
-
- if ($method eq 'GET' || $method eq 'HEAD') {
- if (my $mod_time = $ftp->mdtm($remote_file)) {
- $response->last_modified($mod_time);
- if (my $ims = $request->if_modified_since) {
- if ($mod_time <= $ims) {
- $response->code(HTTP::Status::RC_NOT_MODIFIED);
- $response->message("Not modified");
- return $response;
- }
- }
- }
-
- # We'll use this later to abort the transfer if necessary.
- # if $max_size is defined, we need to abort early. Otherwise, it's
- # a normal transfer
- my $max_size = undef;
-
- # Set resume location, if the client requested it
- if ($request->header('Range') && $ftp->supported('REST')) {
- my $range_info = $request->header('Range');
-
- # Change bytes=2772992-6781209 to just 2772992
- my ($start_byte, $end_byte) = $range_info =~ /.*=\s*(\d+)-(\d+)?/;
- if (defined $start_byte && !defined $end_byte) {
-
- # open range -- only the start is specified
-
- $ftp->restart($start_byte);
-
- # don't define $max_size, we don't want to abort early
- }
- elsif (defined $start_byte
- && defined $end_byte
- && $start_byte >= 0
- && $end_byte >= $start_byte)
- {
-
- $ftp->restart($start_byte);
- $max_size = $end_byte - $start_byte;
- }
- else {
-
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'Incorrect syntax for Range request');
- }
- }
- elsif ($request->header('Range') && !$ftp->supported('REST')) {
- return HTTP::Response->new(HTTP::Status::RC_NOT_IMPLEMENTED,
- "Server does not support resume."
- );
- }
-
- my $data; # the data handle
- if (length($remote_file) and $data = $ftp->retr($remote_file)) {
- my ($type, @enc) = LWP::MediaTypes::guess_media_type($remote_file);
- $response->header('Content-Type', $type) if $type;
- for (@enc) {
- $response->push_header('Content-Encoding', $_);
- }
- my $mess = $ftp->message;
- if ($mess =~ /\((\d+)\s+bytes\)/) {
- $response->header('Content-Length', "$1");
- }
-
- if ($method ne 'HEAD') {
-
- # Read data from server
- $response = $self->collect(
- $arg,
- $response,
- sub {
- my $content = '';
- my $result = $data->read($content, $size);
-
- # Stop early if we need to.
- if (defined $max_size) {
-
- # We need an interface to Net::FTP::dataconn for getting
- # the number of bytes already read
- my $bytes_received = $data->bytes_read();
-
- # We were already over the limit. (Should only happen
- # once at the end.)
- if ($bytes_received - length($content) > $max_size)
- {
- $content = '';
- }
-
- # We just went over the limit
- elsif ($bytes_received > $max_size) {
-
- # Trim content
- $content = substr($content, 0,
- $max_size
- - ($bytes_received - length($content)));
- }
-
- # We're under the limit
- else {
- }
- }
-
- return \$content;
- }
- );
- }
-
- # abort is needed for HEAD, it's == close if the transfer has
- # already completed.
- unless ($data->abort) {
-
- # Something did not work too well. Note that we treat
- # responses to abort() with code 0 in case of HEAD as ok
- # (at least wu-ftpd 2.6.1(1) does that).
- if ($method ne 'HEAD' || $ftp->code != 0) {
- $response->code(HTTP::Status::RC_INTERNAL_SERVER_ERROR);
- $response->message("FTP close response: "
- . $ftp->code . " "
- . $ftp->message);
- }
- }
- }
- elsif (!length($remote_file) || ($ftp->code >= 400 && $ftp->code < 600))
- {
- # not a plain file, try to list instead
- if (length($remote_file) && !$ftp->cwd($remote_file)) {
- return HTTP::Response->new(HTTP::Status::RC_NOT_FOUND,
- "File '$remote_file' not found"
- );
- }
-
- # It should now be safe to try to list the directory
- my @lsl = $ftp->dir;
-
- # Try to figure out if the user want us to convert the
- # directory listing to HTML.
- my @variants = (
- ['html', 0.60, 'text/html'],
- ['dir', 1.00, 'text/ftp-dir-listing']
- );
-
- #$HTTP::Negotiate::DEBUG=1;
- my $prefer = HTTP::Negotiate::choose(\@variants, $request);
-
- my $content = '';
-
- if (!defined($prefer)) {
- return HTTP::Response->new(HTTP::Status::RC_NOT_ACCEPTABLE,
- "Neither HTML nor directory listing wanted");
- }
- elsif ($prefer eq 'html') {
- $response->header('Content-Type' => 'text/html');
- $content = "<HEAD><TITLE>File Listing</TITLE>\n";
- my $base = $request->uri->clone;
- my $path = $base->path;
- $base->path("$path/") unless $path =~ m|/$|;
- $content .= qq(<BASE HREF="$base">\n</HEAD>\n);
- $content .= "<BODY>\n<UL>\n";
- for (File::Listing::parse_dir(\@lsl, 'GMT')) {
- my ($name, $type, $size, $mtime, $mode) = @$_;
- $content .= qq( <LI> <a href="$name">$name</a>);
- $content .= " $size bytes" if $type eq 'f';
- $content .= "\n";
- }
- $content .= "</UL></body>\n";
- }
- else {
- $response->header('Content-Type', 'text/ftp-dir-listing');
- $content = join("\n", @lsl, '');
- }
-
- $response->header('Content-Length', length($content));
-
- if ($method ne 'HEAD') {
- $response = $self->collect_once($arg, $response, $content);
- }
- }
- else {
- my $res = HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- "FTP return code " . $ftp->code);
- $res->content_type("text/plain");
- $res->content($ftp->message);
- return $res;
- }
- }
- elsif ($method eq 'PUT') {
-
- # method must be PUT
- unless (length($remote_file)) {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- "Must have a file name to PUT to"
- );
- }
- my $data;
- if ($data = $ftp->stor($remote_file)) {
- my $content = $request->content;
- my $bytes = 0;
- if (defined $content) {
- if (ref($content) eq 'SCALAR') {
- $bytes = $data->write($$content, length($$content));
- }
- elsif (ref($content) eq 'CODE') {
- my ($buf, $n);
- while (length($buf = &$content)) {
- $n = $data->write($buf, length($buf));
- last unless $n;
- $bytes += $n;
- }
- }
- elsif (!ref($content)) {
- if (defined $content && length($content)) {
- $bytes = $data->write($content, length($content));
- }
- }
- else {
- die "Bad content";
- }
- }
- $data->close;
-
- $response->code(HTTP::Status::RC_CREATED);
- $response->header('Content-Type', 'text/plain');
- $response->content("$bytes bytes stored as $remote_file on $host\n")
-
- }
- else {
- my $res = HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- "FTP return code " . $ftp->code);
- $res->content_type("text/plain");
- $res->content($ftp->message);
- return $res;
- }
- }
- else {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- "Illegal method $method");
- }
-
- $response;
-}
-
-1;
-
-__END__
-
-# This is what RFC 1738 has to say about FTP access:
-# --------------------------------------------------
-#
-# 3.2. FTP
-#
-# The FTP URL scheme is used to designate files and directories on
-# Internet hosts accessible using the FTP protocol (RFC959).
-#
-# A FTP URL follow the syntax described in Section 3.1. If :<port> is
-# omitted, the port defaults to 21.
-#
-# 3.2.1. FTP Name and Password
-#
-# A user name and password may be supplied; they are used in the ftp
-# "USER" and "PASS" commands after first making the connection to the
-# FTP server. If no user name or password is supplied and one is
-# requested by the FTP server, the conventions for "anonymous" FTP are
-# to be used, as follows:
-#
-# The user name "anonymous" is supplied.
-#
-# The password is supplied as the Internet e-mail address
-# of the end user accessing the resource.
-#
-# If the URL supplies a user name but no password, and the remote
-# server requests a password, the program interpreting the FTP URL
-# should request one from the user.
-#
-# 3.2.2. FTP url-path
-#
-# The url-path of a FTP URL has the following syntax:
-#
-# <cwd1>/<cwd2>/.../<cwdN>/<name>;type=<typecode>
-#
-# Where <cwd1> through <cwdN> and <name> are (possibly encoded) strings
-# and <typecode> is one of the characters "a", "i", or "d". The part
-# ";type=<typecode>" may be omitted. The <cwdx> and <name> parts may be
-# empty. The whole url-path may be omitted, including the "/"
-# delimiting it from the prefix containing user, password, host, and
-# port.
-#
-# The url-path is interpreted as a series of FTP commands as follows:
-#
-# Each of the <cwd> elements is to be supplied, sequentially, as the
-# argument to a CWD (change working directory) command.
-#
-# If the typecode is "d", perform a NLST (name list) command with
-# <name> as the argument, and interpret the results as a file
-# directory listing.
-#
-# Otherwise, perform a TYPE command with <typecode> as the argument,
-# and then access the file whose name is <name> (for example, using
-# the RETR command.)
-#
-# Within a name or CWD component, the characters "/" and ";" are
-# reserved and must be encoded. The components are decoded prior to
-# their use in the FTP protocol. In particular, if the appropriate FTP
-# sequence to access a particular file requires supplying a string
-# containing a "/" as an argument to a CWD or RETR command, it is
-# necessary to encode each "/".
-#
-# For example, the URL <URL:ftp://myname@host.dom/%2Fetc/motd> is
-# interpreted by FTP-ing to "host.dom", logging in as "myname"
-# (prompting for a password if it is asked for), and then executing
-# "CWD /etc" and then "RETR motd". This has a different meaning from
-# <URL:ftp://myname@host.dom/etc/motd> which would "CWD etc" and then
-# "RETR motd"; the initial "CWD" might be executed relative to the
-# default directory for "myname". On the other hand,
-# <URL:ftp://myname@host.dom//etc/motd>, would "CWD " with a null
-# argument, then "CWD etc", and then "RETR motd".
-#
-# FTP URLs may also be used for other operations; for example, it is
-# possible to update a file on a remote file server, or infer
-# information about it from the directory listings. The mechanism for
-# doing so is not spelled out here.
-#
-# 3.2.3. FTP Typecode is Optional
-#
-# The entire ;type=<typecode> part of a FTP URL is optional. If it is
-# omitted, the client program interpreting the URL must guess the
-# appropriate mode to use. In general, the data content type of a file
-# can only be guessed from the name, e.g., from the suffix of the name;
-# the appropriate type code to be used for transfer of the file can
-# then be deduced from the data content of the file.
-#
-# 3.2.4 Hierarchy
-#
-# For some file systems, the "/" used to denote the hierarchical
-# structure of the URL corresponds to the delimiter used to construct a
-# file name hierarchy, and thus, the filename will look similar to the
-# URL path. This does NOT mean that the URL is a Unix filename.
-#
-# 3.2.5. Optimization
-#
-# Clients accessing resources via FTP may employ additional heuristics
-# to optimize the interaction. For some FTP servers, for example, it
-# may be reasonable to keep the control connection open while accessing
-# multiple URLs from the same server. However, there is no common
-# hierarchical model to the FTP protocol, so if a directory change
-# command has been given, it is impossible in general to deduce what
-# sequence should be given to navigate to another directory for a
-# second retrieval, if the paths are different. The only reliable
-# algorithm is to disconnect and reestablish the control connection.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/gopher.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/gopher.pm
deleted file mode 100644
index 1b46df4a07..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/gopher.pm
+++ /dev/null
@@ -1,213 +0,0 @@
-package LWP::Protocol::gopher;
-
-# Implementation of the gopher protocol (RFC 1436)
-#
-# This code is based on 'wwwgopher.pl,v 0.10 1994/10/17 18:12:34 shelden'
-# which in turn is a vastly modified version of Oscar's http'get()
-# dated 28/3/94 in <ftp://cui.unige.ch/PUBLIC/oscar/scripts/http.pl>
-# including contributions from Marc van Heyningen and Martijn Koster.
-
-use strict;
-
-our $VERSION = '6.61';
-
-require HTTP::Response;
-require HTTP::Status;
-require IO::Socket;
-require IO::Select;
-
-use parent qw(LWP::Protocol);
-
-
-my %gopher2mimetype = (
- '0' => 'text/plain', # 0 file
- '1' => 'text/html', # 1 menu
- # 2 CSO phone-book server
- # 3 Error
- '4' => 'application/mac-binhex40', # 4 BinHexed Macintosh file
- '5' => 'application/zip', # 5 DOS binary archive of some sort
- '6' => 'application/octet-stream', # 6 UNIX uuencoded file.
- '7' => 'text/html', # 7 Index-Search server
- # 8 telnet session
- '9' => 'application/octet-stream', # 9 binary file
- 'h' => 'text/html', # html
- 'g' => 'image/gif', # gif
- 'I' => 'image/*', # some kind of image
-);
-
-my %gopher2encoding = (
- '6' => 'x_uuencode', # 6 UNIX uuencoded file.
-);
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size, $timeout) = @_;
-
- $size = 4096 unless $size;
-
- # check proxy
- if (defined $proxy) {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy through the gopher');
- }
-
- my $url = $request->uri;
- die "bad scheme" if $url->scheme ne 'gopher';
-
-
- my $method = $request->method;
- unless ($method eq 'GET' || $method eq 'HEAD') {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'gopher:' URLs");
- }
-
- my $gophertype = $url->gopher_type;
- unless (exists $gopher2mimetype{$gophertype}) {
- return HTTP::Response->new(HTTP::Status::RC_NOT_IMPLEMENTED,
- 'Library does not support gophertype ' .
- $gophertype);
- }
-
- my $response = HTTP::Response->new(HTTP::Status::RC_OK, "OK");
- $response->header('Content-type' => $gopher2mimetype{$gophertype}
- || 'text/plain');
- $response->header('Content-Encoding' => $gopher2encoding{$gophertype})
- if exists $gopher2encoding{$gophertype};
-
- if ($method eq 'HEAD') {
- # XXX: don't even try it so we set this header
- $response->header('Client-Warning' => 'Client answer only');
- return $response;
- }
-
- if ($gophertype eq '7' && ! $url->search) {
- # the url is the prompt for a gopher search; supply boiler-plate
- return $self->collect_once($arg, $response, <<"EOT");
-<HEAD>
-<TITLE>Gopher Index</TITLE>
-<ISINDEX>
-</HEAD>
-<BODY>
-<H1>$url<BR>Gopher Search</H1>
-This is a searchable Gopher index.
-Use the search function of your browser to enter search terms.
-</BODY>
-EOT
- }
-
- my $host = $url->host;
- my $port = $url->port;
-
- my $requestLine = "";
-
- my $selector = $url->selector;
- if (defined $selector) {
- $requestLine .= $selector;
- my $search = $url->search;
- if (defined $search) {
- $requestLine .= "\t$search";
- my $string = $url->string;
- if (defined $string) {
- $requestLine .= "\t$string";
- }
- }
- }
- $requestLine .= "\015\012";
-
- # potential request headers are just ignored
-
- # Ok, lets make the request
- my $socket = IO::Socket::INET->new(PeerAddr => $host,
- PeerPort => $port,
- LocalAddr => $self->{ua}{local_address},
- Proto => 'tcp',
- Timeout => $timeout);
- die "Can't connect to $host:$port" unless $socket;
- my $sel = IO::Select->new($socket);
-
- {
- die "write timeout" if $timeout && !$sel->can_write($timeout);
- my $n = syswrite($socket, $requestLine, length($requestLine));
- die $! unless defined($n);
- die "short write" if $n != length($requestLine);
- }
-
- my $user_arg = $arg;
-
- # must handle menus in a special way since they are to be
- # converted to HTML. Undefing $arg ensures that the user does
- # not see the data before we get a change to convert it.
- $arg = undef if $gophertype eq '1' || $gophertype eq '7';
-
- # collect response
- my $buf = '';
- $response = $self->collect($arg, $response, sub {
- die "read timeout" if $timeout && !$sel->can_read($timeout);
- my $n = sysread($socket, $buf, $size);
- die $! unless defined($n);
- return \$buf;
- } );
-
- # Convert menu to HTML and return data to user.
- if ($gophertype eq '1' || $gophertype eq '7') {
- my $content = menu2html($response->content);
- if (defined $user_arg) {
- $response = $self->collect_once($user_arg, $response, $content);
- }
- else {
- $response->content($content);
- }
- }
-
- $response;
-}
-
-
-sub gopher2url
-{
- my($gophertype, $path, $host, $port) = @_;
-
- my $url;
-
- if ($gophertype eq '8' || $gophertype eq 'T') {
- # telnet session
- $url = $HTTP::URI_CLASS->new($gophertype eq '8' ? 'telnet:':'tn3270:');
- $url->user($path) if defined $path;
- }
- else {
- $path = URI::Escape::uri_escape($path);
- $url = $HTTP::URI_CLASS->new("gopher:/$gophertype$path");
- }
- $url->host($host);
- $url->port($port);
- $url;
-}
-
-sub menu2html {
- my($menu) = @_;
-
- $menu =~ tr/\015//d; # remove carriage return
- my $tmp = <<"EOT";
-<HTML>
-<HEAD>
- <TITLE>Gopher menu</TITLE>
-</HEAD>
-<BODY>
-<H1>Gopher menu</H1>
-EOT
- for (split("\n", $menu)) {
- last if /^\./;
- my($pretty, $path, $host, $port) = split("\t");
-
- $pretty =~ s/^(.)//;
- my $type = $1;
-
- my $url = gopher2url($type, $path, $host, $port)->as_string;
- $tmp .= qq{<A HREF="$url">$pretty</A><BR>\n};
- }
- $tmp .= "</BODY>\n</HTML>\n";
- $tmp;
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/http.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/http.pm
deleted file mode 100644
index 88b4c60df3..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/http.pm
+++ /dev/null
@@ -1,523 +0,0 @@
-package LWP::Protocol::http;
-
-use strict;
-
-our $VERSION = '6.61';
-
-require HTTP::Response;
-require HTTP::Status;
-require Net::HTTP;
-
-use parent qw(LWP::Protocol);
-
-our @EXTRA_SOCK_OPTS;
-my $CRLF = "\015\012";
-
-sub _new_socket
-{
- my($self, $host, $port, $timeout) = @_;
-
- # IPv6 literal IP address should be [bracketed] to remove
- # ambiguity between ip address and port number.
- if ( ($host =~ /:/) && ($host !~ /^\[/) ) {
- $host = "[$host]";
- }
-
- local($^W) = 0; # IO::Socket::INET can be noisy
- my $sock = $self->socket_class->new(PeerAddr => $host,
- PeerPort => $port,
- LocalAddr => $self->{ua}{local_address},
- Proto => 'tcp',
- Timeout => $timeout,
- KeepAlive => !!$self->{ua}{conn_cache},
- SendTE => $self->{ua}{send_te},
- $self->_extra_sock_opts($host, $port),
- );
-
- unless ($sock) {
- # IO::Socket::INET leaves additional error messages in $@
- my $status = "Can't connect to $host:$port";
- if ($@ =~ /\bconnect: (.*)/ ||
- $@ =~ /\b(Bad hostname)\b/ ||
- $@ =~ /\b(nodename nor servname provided, or not known)\b/ ||
- $@ =~ /\b(certificate verify failed)\b/ ||
- $@ =~ /\b(Crypt-SSLeay can't verify hostnames)\b/
- ) {
- $status .= " ($1)";
- } elsif ($@) {
- $status .= " ($@)";
- }
- die "$status\n\n$@";
- }
-
- # perl 5.005's IO::Socket does not have the blocking method.
- eval { $sock->blocking(0); };
-
- $sock;
-}
-
-sub socket_type
-{
- return "http";
-}
-
-sub socket_class
-{
- my $self = shift;
- (ref($self) || $self) . "::Socket";
-}
-
-sub _extra_sock_opts # to be overridden by subclass
-{
- return @EXTRA_SOCK_OPTS;
-}
-
-sub _check_sock
-{
- #my($self, $req, $sock) = @_;
-}
-
-sub _get_sock_info
-{
- my($self, $res, $sock) = @_;
- if (defined(my $peerhost = $sock->peerhost)) {
- $res->header("Client-Peer" => "$peerhost:" . $sock->peerport);
- }
-}
-
-sub _fixup_header
-{
- my($self, $h, $url, $proxy) = @_;
-
- # Extract 'Host' header
- my $hhost = $url->authority;
- if ($hhost =~ s/^([^\@]*)\@//) { # get rid of potential "user:pass@"
- # add authorization header if we need them. HTTP URLs do
- # not really support specification of user and password, but
- # we allow it.
- if (defined($1) && not $h->header('Authorization')) {
- require URI::Escape;
- $h->authorization_basic(map URI::Escape::uri_unescape($_),
- split(":", $1, 2));
- }
- }
- $h->init_header('Host' => $hhost);
-
- if ($proxy && $url->scheme ne 'https') {
- # Check the proxy URI's userinfo() for proxy credentials
- # export http_proxy="http://proxyuser:proxypass@proxyhost:port".
- # For https only the initial CONNECT requests needs authorization.
- my $p_auth = $proxy->userinfo();
- if(defined $p_auth) {
- require URI::Escape;
- $h->proxy_authorization_basic(map URI::Escape::uri_unescape($_),
- split(":", $p_auth, 2))
- }
- }
-}
-
-sub hlist_remove {
- my($hlist, $k) = @_;
- $k = lc $k;
- for (my $i = @$hlist - 2; $i >= 0; $i -= 2) {
- next unless lc($hlist->[$i]) eq $k;
- splice(@$hlist, $i, 2);
- }
-}
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size, $timeout) = @_;
-
- $size ||= 4096;
-
- # check method
- my $method = $request->method;
- unless ($method =~ /^[A-Za-z0-9_!\#\$%&\'*+\-.^\`|~]+$/) { # HTTP token
- return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'http:' URLs");
- }
-
- my $url = $request->uri;
-
- # Proxying SSL with a http proxy needs issues a CONNECT request to build a
- # tunnel and then upgrades the tunnel to SSL. But when doing keep-alive the
- # https request does not need to be the first request in the connection, so
- # we need to distinguish between
- # - not yet connected (create socket and ssl upgrade)
- # - connected but not inside ssl tunnel (ssl upgrade)
- # - inside ssl tunnel to the target - once we are in the tunnel to the
- # target we cannot only reuse the tunnel for more https requests with the
- # same target
-
- my $ssl_tunnel = $proxy && $url->scheme eq 'https'
- && $url->host.":".$url->port;
-
- my ($host,$port) = $proxy
- ? ($proxy->host,$proxy->port)
- : ($url->host,$url->port);
- my $fullpath =
- $method eq 'CONNECT' ? $url->host . ":" . $url->port :
- $proxy && ! $ssl_tunnel ? $url->as_string :
- do {
- my $path = $url->path_query;
- $path = "/$path" if $path !~m{^/};
- $path
- };
-
- my $socket;
- my $conn_cache = $self->{ua}{conn_cache};
- my $cache_key;
- if ( $conn_cache ) {
- $cache_key = "$host:$port";
- # For https we reuse the socket immediately only if it has an established
- # tunnel to the target. Otherwise a CONNECT request followed by an SSL
- # upgrade need to be done first. The request itself might reuse an
- # existing non-ssl connection to the proxy
- $cache_key .= "!".$ssl_tunnel if $ssl_tunnel;
- if ( $socket = $conn_cache->withdraw($self->socket_type,$cache_key)) {
- if ($socket->can_read(0)) {
- # if the socket is readable, then either the peer has closed the
- # connection or there are some garbage bytes on it. In either
- # case we abandon it.
- $socket->close;
- $socket = undef;
- } # else use $socket
- else {
- $socket->timeout($timeout);
- }
- }
- }
-
- if ( ! $socket && $ssl_tunnel ) {
- my $proto_https = LWP::Protocol::create('https',$self->{ua})
- or die "no support for scheme https found";
-
- # only if ssl socket class is IO::Socket::SSL we can upgrade
- # a plain socket to SSL. In case of Net::SSL we fall back to
- # the old version
- if ( my $upgrade_sub = $proto_https->can('_upgrade_sock')) {
- my $response = $self->request(
- HTTP::Request->new('CONNECT',"http://$ssl_tunnel"),
- $proxy,
- undef,$size,$timeout
- );
- $response->is_success or die
- "establishing SSL tunnel failed: ".$response->status_line;
- $socket = $upgrade_sub->($proto_https,
- $response->{client_socket},$url)
- or die "SSL upgrade failed: $@";
- } else {
- $socket = $proto_https->_new_socket($url->host,$url->port,$timeout);
- }
- }
-
- if ( ! $socket ) {
- # connect to remote site w/o reusing established socket
- $socket = $self->_new_socket($host, $port, $timeout );
- }
-
- my $http_version = "";
- if (my $proto = $request->protocol) {
- if ($proto =~ /^(?:HTTP\/)?(1.\d+)$/) {
- $http_version = $1;
- $socket->http_version($http_version);
- $socket->send_te(0) if $http_version eq "1.0";
- }
- }
-
- $self->_check_sock($request, $socket);
-
- my @h;
- my $request_headers = $request->headers->clone;
- $self->_fixup_header($request_headers, $url, $proxy);
-
- $request_headers->scan(sub {
- my($k, $v) = @_;
- $k =~ s/^://;
- $v =~ tr/\n/ /;
- push(@h, $k, $v);
- });
-
- my $content_ref = $request->content_ref;
- $content_ref = $$content_ref if ref($$content_ref);
- my $chunked;
- my $has_content;
-
- if (ref($content_ref) eq 'CODE') {
- my $clen = $request_headers->header('Content-Length');
- $has_content++ if $clen;
- unless (defined $clen) {
- push(@h, "Transfer-Encoding" => "chunked");
- $has_content++;
- $chunked++;
- }
- }
- else {
- # Set (or override) Content-Length header
- my $clen = $request_headers->header('Content-Length');
- if (defined($$content_ref) && length($$content_ref)) {
- $has_content = length($$content_ref);
- if (!defined($clen) || $clen ne $has_content) {
- if (defined $clen) {
- warn "Content-Length header value was wrong, fixed";
- hlist_remove(\@h, 'Content-Length');
- }
- push(@h, 'Content-Length' => $has_content);
- }
- }
- elsif ($clen) {
- warn "Content-Length set when there is no content, fixed";
- hlist_remove(\@h, 'Content-Length');
- }
- }
-
- my $write_wait = 0;
- $write_wait = 2
- if ($request_headers->header("Expect") || "") =~ /100-continue/;
-
- my $req_buf = $socket->format_request($method, $fullpath, @h);
- #print "------\n$req_buf\n------\n";
-
- if (!$has_content || $write_wait || $has_content > 8*1024) {
- WRITE:
- {
- # Since this just writes out the header block it should almost
- # always succeed to send the whole buffer in a single write call.
- my $n = $socket->syswrite($req_buf, length($req_buf));
- unless (defined $n) {
- redo WRITE if $!{EINTR};
- if ($!{EWOULDBLOCK} || $!{EAGAIN}) {
- select(undef, undef, undef, 0.1);
- redo WRITE;
- }
- die "write failed: $!";
- }
- if ($n) {
- substr($req_buf, 0, $n, "");
- }
- else {
- select(undef, undef, undef, 0.5);
- }
- redo WRITE if length $req_buf;
- }
- }
-
- my($code, $mess, @junk);
- my $drop_connection;
-
- if ($has_content) {
- my $eof;
- my $wbuf;
- my $woffset = 0;
- INITIAL_READ:
- if ($write_wait) {
- # skip filling $wbuf when waiting for 100-continue
- # because if the response is a redirect or auth required
- # the request will be cloned and there is no way
- # to reset the input stream
- # return here via the label after the 100-continue is read
- }
- elsif (ref($content_ref) eq 'CODE') {
- my $buf = &$content_ref();
- $buf = "" unless defined($buf);
- $buf = sprintf "%x%s%s%s", length($buf), $CRLF, $buf, $CRLF
- if $chunked;
- substr($buf, 0, 0) = $req_buf if $req_buf;
- $wbuf = \$buf;
- }
- else {
- if ($req_buf) {
- my $buf = $req_buf . $$content_ref;
- $wbuf = \$buf;
- }
- else {
- $wbuf = $content_ref;
- }
- $eof = 1;
- }
-
- my $fbits = '';
- vec($fbits, fileno($socket), 1) = 1;
-
- WRITE:
- while ($write_wait || $woffset < length($$wbuf)) {
-
- my $sel_timeout = $timeout;
- if ($write_wait) {
- $sel_timeout = $write_wait if $write_wait < $sel_timeout;
- }
- my $time_before;
- $time_before = time if $sel_timeout;
-
- my $rbits = $fbits;
- my $wbits = $write_wait ? undef : $fbits;
- my $sel_timeout_before = $sel_timeout;
- SELECT:
- {
- my $nfound = select($rbits, $wbits, undef, $sel_timeout);
- if ($nfound < 0) {
- if ($!{EINTR} || $!{EWOULDBLOCK} || $!{EAGAIN}) {
- if ($time_before) {
- $sel_timeout = $sel_timeout_before - (time - $time_before);
- $sel_timeout = 0 if $sel_timeout < 0;
- }
- redo SELECT;
- }
- die "select failed: $!";
- }
- }
-
- if ($write_wait) {
- $write_wait -= time - $time_before;
- $write_wait = 0 if $write_wait < 0;
- }
-
- if (defined($rbits) && $rbits =~ /[^\0]/) {
- # readable
- my $buf = $socket->_rbuf;
- my $n = $socket->sysread($buf, 1024, length($buf));
- unless (defined $n) {
- die "read failed: $!" unless $!{EINTR} || $!{EWOULDBLOCK} || $!{EAGAIN};
- # if we get here the rest of the block will do nothing
- # and we will retry the read on the next round
- }
- elsif ($n == 0) {
- # the server closed the connection before we finished
- # writing all the request content. No need to write any more.
- $drop_connection++;
- last WRITE;
- }
- $socket->_rbuf($buf);
- if (!$code && $buf =~ /\015?\012\015?\012/) {
- # a whole response header is present, so we can read it without blocking
- ($code, $mess, @h) = $socket->read_response_headers(laxed => 1,
- junk_out => \@junk,
- );
- if ($code eq "100") {
- $write_wait = 0;
- undef($code);
- goto INITIAL_READ;
- }
- else {
- $drop_connection++;
- last WRITE;
- # XXX should perhaps try to abort write in a nice way too
- }
- }
- }
- if (defined($wbits) && $wbits =~ /[^\0]/) {
- my $n = $socket->syswrite($$wbuf, length($$wbuf), $woffset);
- unless (defined $n) {
- die "write failed: $!" unless $!{EINTR} || $!{EWOULDBLOCK} || $!{EAGAIN};
- $n = 0; # will retry write on the next round
- }
- elsif ($n == 0) {
- die "write failed: no bytes written";
- }
- $woffset += $n;
-
- if (!$eof && $woffset >= length($$wbuf)) {
- # need to refill buffer from $content_ref code
- my $buf = &$content_ref();
- $buf = "" unless defined($buf);
- $eof++ unless length($buf);
- $buf = sprintf "%x%s%s%s", length($buf), $CRLF, $buf, $CRLF
- if $chunked;
- $wbuf = \$buf;
- $woffset = 0;
- }
- }
- } # WRITE
- }
-
- ($code, $mess, @h) = $socket->read_response_headers(laxed => 1, junk_out => \@junk)
- unless $code;
- ($code, $mess, @h) = $socket->read_response_headers(laxed => 1, junk_out => \@junk)
- if $code eq "100";
-
- my $response = HTTP::Response->new($code, $mess);
- my $peer_http_version = $socket->peer_http_version;
- $response->protocol("HTTP/$peer_http_version");
- {
- local $HTTP::Headers::TRANSLATE_UNDERSCORE;
- $response->push_header(@h);
- }
- $response->push_header("Client-Junk" => \@junk) if @junk;
-
- $response->request($request);
- $self->_get_sock_info($response, $socket);
-
- if ($method eq "CONNECT") {
- $response->{client_socket} = $socket; # so it can be picked up
- return $response;
- }
-
- if (my @te = $response->remove_header('Transfer-Encoding')) {
- $response->push_header('Client-Transfer-Encoding', \@te);
- }
- $response->push_header('Client-Response-Num', scalar $socket->increment_response_count);
-
- my $complete;
- $response = $self->collect($arg, $response, sub {
- my $buf = ""; #prevent use of uninitialized value in SSLeay.xs
- my $n;
- READ:
- {
- $n = $socket->read_entity_body($buf, $size);
- unless (defined $n) {
- redo READ if $!{EINTR} || $!{EWOULDBLOCK} || $!{EAGAIN} || $!{ENOTTY};
- die "read failed: $!";
- }
- redo READ if $n == -1;
- }
- $complete++ if !$n;
- return \$buf;
- } );
- $drop_connection++ unless $complete;
-
- @h = $socket->get_trailers;
- if (@h) {
- local $HTTP::Headers::TRANSLATE_UNDERSCORE;
- $response->push_header(@h);
- }
-
- # keep-alive support
- unless ($drop_connection) {
- if ($cache_key) {
- my %connection = map { (lc($_) => 1) }
- split(/\s*,\s*/, ($response->header("Connection") || ""));
- if (($peer_http_version eq "1.1" && !$connection{close}) ||
- $connection{"keep-alive"})
- {
- $conn_cache->deposit($self->socket_type, $cache_key, $socket);
- }
- }
- }
-
- $response;
-}
-
-
-#-----------------------------------------------------------
-package # hide from PAUSE
- LWP::Protocol::http::SocketMethods;
-
-sub ping {
- my $self = shift;
- !$self->can_read(0);
-}
-
-sub increment_response_count {
- my $self = shift;
- return ++${*$self}{'myhttp_response_count'};
-}
-
-#-----------------------------------------------------------
-package # hide from PAUSE
- LWP::Protocol::http::Socket;
-
-use parent -norequire, qw(LWP::Protocol::http::SocketMethods Net::HTTP);
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/loopback.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/loopback.pm
deleted file mode 100644
index a1b095ea70..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/loopback.pm
+++ /dev/null
@@ -1,27 +0,0 @@
-package LWP::Protocol::loopback;
-
-use strict;
-
-our $VERSION = '6.61';
-
-require HTTP::Response;
-
-use parent qw(LWP::Protocol);
-
-sub request {
- my($self, $request, $proxy, $arg, $size, $timeout) = @_;
-
- my $response = HTTP::Response->new(200, "OK");
- $response->content_type("message/http; msgtype=request");
-
- $response->header("Via", "loopback/1.0 $proxy")
- if $proxy;
-
- $response->header("X-Arg", $arg);
- $response->header("X-Read-Size", $size);
- $response->header("X-Timeout", $timeout);
-
- return $self->collect_once($arg, $response, $request->as_string);
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm
deleted file mode 100644
index 29f934bb26..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm
+++ /dev/null
@@ -1,184 +0,0 @@
-package LWP::Protocol::mailto;
-
-# This module implements the mailto protocol. It is just a simple
-# frontend to the Unix sendmail program except on MacOS, where it uses
-# Mail::Internet.
-
-require HTTP::Request;
-require HTTP::Response;
-require HTTP::Status;
-
-use Carp;
-use strict;
-
-our $VERSION = '6.61';
-
-use parent qw(LWP::Protocol);
-our $SENDMAIL;
-
-unless ($SENDMAIL = $ENV{SENDMAIL}) {
- for my $sm (qw(/usr/sbin/sendmail
- /usr/lib/sendmail
- /usr/ucblib/sendmail
- ))
- {
- if (-x $sm) {
- $SENDMAIL = $sm;
- last;
- }
- }
- die "Can't find the 'sendmail' program" unless $SENDMAIL;
-}
-
-sub request
-{
- my($self, $request, $proxy, $arg, $size) = @_;
-
- my ($mail, $addr) if $^O eq "MacOS";
- my @text = () if $^O eq "MacOS";
-
- # check proxy
- if (defined $proxy)
- {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy with mail');
- }
-
- # check method
- my $method = $request->method;
-
- if ($method ne 'POST') {
- return HTTP::Response->new( HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' .
- "$method for 'mailto:' URLs");
- }
-
- # check url
- my $url = $request->uri;
-
- my $scheme = $url->scheme;
- if ($scheme ne 'mailto') {
- return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::mailto::request called for '$scheme'");
- }
- if ($^O eq "MacOS") {
- eval {
- require Mail::Internet;
- };
- if($@) {
- return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have MailTools installed");
- }
- unless ($ENV{SMTPHOSTS}) {
- return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have SMTPHOSTS defined");
- }
- }
- else {
- unless (-x $SENDMAIL) {
- return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "You don't have $SENDMAIL");
- }
- }
- if ($^O eq "MacOS") {
- $mail = Mail::Internet->new or
- return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Can't get a Mail::Internet object");
- }
- else {
- open(SENDMAIL, "| $SENDMAIL -oi -t") or
- return HTTP::Response->new( HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Can't run $SENDMAIL: $!");
- }
- if ($^O eq "MacOS") {
- $addr = $url->encoded822addr;
- }
- else {
- $request = $request->clone; # we modify a copy
- my @h = $url->headers; # URL headers override those in the request
- while (@h) {
- my $k = shift @h;
- my $v = shift @h;
- next unless defined $v;
- if (lc($k) eq "body") {
- $request->content($v);
- }
- else {
- $request->push_header($k => $v);
- }
- }
- }
- if ($^O eq "MacOS") {
- $mail->add(To => $addr);
- $mail->add(split(/[:\n]/,$request->headers_as_string));
- }
- else {
- print SENDMAIL $request->headers_as_string;
- print SENDMAIL "\n";
- }
- my $content = $request->content;
- if (defined $content) {
- my $contRef = ref($content) ? $content : \$content;
- if (ref($contRef) eq 'SCALAR') {
- if ($^O eq "MacOS") {
- @text = split("\n",$$contRef);
- foreach (@text) {
- $_ .= "\n";
- }
- }
- else {
- print SENDMAIL $$contRef;
- }
-
- }
- elsif (ref($contRef) eq 'CODE') {
- # Callback provides data
- my $d;
- if ($^O eq "MacOS") {
- my $stuff = "";
- while (length($d = &$contRef)) {
- $stuff .= $d;
- }
- @text = split("\n",$stuff);
- foreach (@text) {
- $_ .= "\n";
- }
- }
- else {
- print SENDMAIL $d;
- }
- }
- }
- if ($^O eq "MacOS") {
- $mail->body(\@text);
- unless ($mail->smtpsend) {
- return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Mail::Internet->smtpsend unable to send message to <$addr>");
- }
- }
- else {
- unless (close(SENDMAIL)) {
- my $err = $! ? "$!" : "Exit status $?";
- return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "$SENDMAIL: $err");
- }
- }
-
-
- my $response = HTTP::Response->new(HTTP::Status::RC_ACCEPTED,
- "Mail accepted");
- $response->header('Content-Type', 'text/plain');
- if ($^O eq "MacOS") {
- $response->header('Server' => "Mail::Internet $Mail::Internet::VERSION");
- $response->content("Message sent to <$addr>\n");
- }
- else {
- $response->header('Server' => $SENDMAIL);
- my $to = $request->header("To");
- $response->content("Message sent to <$to>\n");
- }
-
- return $response;
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm
deleted file mode 100644
index 1042cd40c3..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm
+++ /dev/null
@@ -1,150 +0,0 @@
-package LWP::Protocol::nntp;
-
-# Implementation of the Network News Transfer Protocol (RFC 977)
-
-use parent qw(LWP::Protocol);
-
-our $VERSION = '6.61';
-
-require HTTP::Response;
-require HTTP::Status;
-require Net::NNTP;
-
-use strict;
-
-
-sub request {
- my ($self, $request, $proxy, $arg, $size, $timeout) = @_;
-
- $size = 4096 unless $size;
-
- # Check for proxy
- if (defined $proxy) {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'You can not proxy through NNTP');
- }
-
- # Check that the scheme is as expected
- my $url = $request->uri;
- my $scheme = $url->scheme;
- unless ($scheme eq 'news' || $scheme eq 'nntp') {
- return HTTP::Response->new(HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "LWP::Protocol::nntp::request called for '$scheme'");
- }
-
- # check for a valid method
- my $method = $request->method;
- unless ($method eq 'GET' || $method eq 'HEAD' || $method eq 'POST') {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- 'Library does not allow method ' . "$method for '$scheme:' URLs");
- }
-
- # extract the identifier and check against posting to an article
- my $groupart = $url->_group;
- my $is_art = $groupart =~ /@/;
-
- if ($is_art && $method eq 'POST') {
- return HTTP::Response->new(HTTP::Status::RC_BAD_REQUEST,
- "Can't post to an article <$groupart>");
- }
-
- my $nntp = Net::NNTP->new(
- $url->host,
-
- #Port => 18574,
- Timeout => $timeout,
-
- #Debug => 1,
- );
- die "Can't connect to nntp server" unless $nntp;
-
- # Check the initial welcome message from the NNTP server
- if ($nntp->status != 2) {
- return HTTP::Response->new(HTTP::Status::RC_SERVICE_UNAVAILABLE,
- $nntp->message);
- }
- my $response = HTTP::Response->new(HTTP::Status::RC_OK, "OK");
-
- my $mess = $nntp->message;
-
- # Try to extract server name from greeting message.
- # Don't know if this works well for a large class of servers, but
- # this works for our server.
- $mess =~ s/\s+ready\b.*//;
- $mess =~ s/^\S+\s+//;
- $response->header(Server => $mess);
-
- # First we handle posting of articles
- if ($method eq 'POST') {
- $nntp->quit;
- $nntp = undef;
- $response->code(HTTP::Status::RC_NOT_IMPLEMENTED);
- $response->message("POST not implemented yet");
- return $response;
- }
-
- # The method must be "GET" or "HEAD" by now
- if (!$is_art) {
- if (!$nntp->group($groupart)) {
- $response->code(HTTP::Status::RC_NOT_FOUND);
- $response->message($nntp->message);
- }
- $nntp->quit;
- $nntp = undef;
-
- # HEAD: just check if the group exists
- if ($method eq 'GET' && $response->is_success) {
- $response->code(HTTP::Status::RC_NOT_IMPLEMENTED);
- $response->message("GET newsgroup not implemented yet");
- }
- return $response;
- }
-
- # Send command to server to retrieve an article (or just the headers)
- my $get = $method eq 'HEAD' ? "head" : "article";
- my $art = $nntp->$get("<$groupart>");
- unless ($art) {
- $nntp->quit;
- $response->code(HTTP::Status::RC_NOT_FOUND);
- $response->message($nntp->message);
- $nntp = undef;
- return $response;
- }
-
- # Parse headers
- my ($key, $val);
- local $_;
- while ($_ = shift @$art) {
- if (/^\s+$/) {
- last; # end of headers
- }
- elsif (/^(\S+):\s*(.*)/) {
- $response->push_header($key, $val) if $key;
- ($key, $val) = ($1, $2);
- }
- elsif (/^\s+(.*)/) {
- next unless $key;
- $val .= $1;
- }
- else {
- unshift(@$art, $_);
- last;
- }
- }
- $response->push_header($key, $val) if $key;
-
- # Ensure that there is a Content-Type header
- $response->header("Content-Type", "text/plain")
- unless $response->header("Content-Type");
-
- # Collect the body
- $response = $self->collect_once($arg, $response, join("", @$art)) if @$art;
-
- # Say goodbye to the server
- $nntp->quit;
- $nntp = undef;
-
- $response;
-}
-
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm
deleted file mode 100644
index dcc54cfc7d..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm
+++ /dev/null
@@ -1,25 +0,0 @@
-package LWP::Protocol::nogo;
-# If you want to disable access to a particular scheme, use this
-# class and then call
-# LWP::Protocol::implementor(that_scheme, 'LWP::Protocol::nogo');
-# For then on, attempts to access URLs with that scheme will generate
-# a 500 error.
-
-use strict;
-
-our $VERSION = '6.61';
-
-require HTTP::Response;
-require HTTP::Status;
-use parent qw(LWP::Protocol);
-
-sub request {
- my($self, $request) = @_;
- my $scheme = $request->uri->scheme;
-
- return HTTP::Response->new(
- HTTP::Status::RC_INTERNAL_SERVER_ERROR,
- "Access to \'$scheme\' URIs has been disabled"
- );
-}
-1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/RobotUA.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/RobotUA.pm
deleted file mode 100644
index 028bdef7af..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/RobotUA.pm
+++ /dev/null
@@ -1,312 +0,0 @@
-package LWP::RobotUA;
-
-use parent qw(LWP::UserAgent);
-
-our $VERSION = '6.61';
-
-require WWW::RobotRules;
-require HTTP::Request;
-require HTTP::Response;
-
-use Carp ();
-use HTTP::Status ();
-use HTTP::Date qw(time2str);
-use strict;
-
-
-#
-# Additional attributes in addition to those found in LWP::UserAgent:
-#
-# $self->{'delay'} Required delay between request to the same
-# server in minutes.
-#
-# $self->{'rules'} A WWW::RobotRules object
-#
-
-sub new
-{
- my $class = shift;
- my %cnf;
- if (@_ < 4) {
- # legacy args
- @cnf{qw(agent from rules)} = @_;
- }
- else {
- %cnf = @_;
- }
-
- Carp::croak('LWP::RobotUA agent required') unless $cnf{agent};
- Carp::croak('LWP::RobotUA from address required')
- unless $cnf{from} && $cnf{from} =~ m/\@/;
-
- my $delay = delete $cnf{delay} || 1;
- my $use_sleep = delete $cnf{use_sleep};
- $use_sleep = 1 unless defined($use_sleep);
- my $rules = delete $cnf{rules};
-
- my $self = LWP::UserAgent->new(%cnf);
- $self = bless $self, $class;
-
- $self->{'delay'} = $delay; # minutes
- $self->{'use_sleep'} = $use_sleep;
-
- if ($rules) {
- $rules->agent($cnf{agent});
- $self->{'rules'} = $rules;
- }
- else {
- $self->{'rules'} = WWW::RobotRules->new($cnf{agent});
- }
-
- $self;
-}
-
-
-sub delay { shift->_elem('delay', @_); }
-sub use_sleep { shift->_elem('use_sleep', @_); }
-
-
-sub agent
-{
- my $self = shift;
- my $old = $self->SUPER::agent(@_);
- if (@_) {
- # Changing our name means to start fresh
- $self->{'rules'}->agent($self->{'agent'});
- }
- $old;
-}
-
-
-sub rules {
- my $self = shift;
- my $old = $self->_elem('rules', @_);
- $self->{'rules'}->agent($self->{'agent'}) if @_;
- $old;
-}
-
-
-sub no_visits
-{
- my($self, $netloc) = @_;
- $self->{'rules'}->no_visits($netloc) || 0;
-}
-
-*host_count = \&no_visits; # backwards compatibility with LWP-5.02
-
-
-sub host_wait
-{
- my($self, $netloc) = @_;
- return undef unless defined $netloc;
- my $last = $self->{'rules'}->last_visit($netloc);
- if ($last) {
- my $wait = int($self->{'delay'} * 60 - (time - $last));
- $wait = 0 if $wait < 0;
- return $wait;
- }
- return 0;
-}
-
-
-sub simple_request
-{
- my($self, $request, $arg, $size) = @_;
-
- # Do we try to access a new server?
- my $allowed = $self->{'rules'}->allowed($request->uri);
-
- if ($allowed < 0) {
- # Host is not visited before, or robots.txt expired; fetch "robots.txt"
- my $robot_url = $request->uri->clone;
- $robot_url->path("robots.txt");
- $robot_url->query(undef);
-
- # make access to robot.txt legal since this will be a recursive call
- $self->{'rules'}->parse($robot_url, "");
-
- my $robot_req = HTTP::Request->new('GET', $robot_url);
- my $parse_head = $self->parse_head(0);
- my $robot_res = $self->request($robot_req);
- $self->parse_head($parse_head);
- my $fresh_until = $robot_res->fresh_until;
- my $content = "";
- if ($robot_res->is_success && $robot_res->content_is_text) {
- $content = $robot_res->decoded_content;
- $content = "" unless $content && $content =~ /^\s*Disallow\s*:/mi;
- }
- $self->{'rules'}->parse($robot_url, $content, $fresh_until);
-
- # recalculate allowed...
- $allowed = $self->{'rules'}->allowed($request->uri);
- }
-
- # Check rules
- unless ($allowed) {
- my $res = HTTP::Response->new(
- HTTP::Status::RC_FORBIDDEN, 'Forbidden by robots.txt');
- $res->request( $request ); # bind it to that request
- return $res;
- }
-
- my $netloc = eval { local $SIG{__DIE__}; $request->uri->host_port; };
- my $wait = $self->host_wait($netloc);
-
- if ($wait) {
- if ($self->{'use_sleep'}) {
- sleep($wait)
- }
- else {
- my $res = HTTP::Response->new(
- HTTP::Status::RC_SERVICE_UNAVAILABLE, 'Please, slow down');
- $res->header('Retry-After', time2str(time + $wait));
- $res->request( $request ); # bind it to that request
- return $res;
- }
- }
-
- # Perform the request
- my $res = $self->SUPER::simple_request($request, $arg, $size);
-
- $self->{'rules'}->visit($netloc);
-
- $res;
-}
-
-
-sub as_string
-{
- my $self = shift;
- my @s;
- push(@s, "Robot: $self->{'agent'} operated by $self->{'from'} [$self]");
- push(@s, " Minimum delay: " . int($self->{'delay'}*60) . "s");
- push(@s, " Will sleep if too early") if $self->{'use_sleep'};
- push(@s, " Rules = $self->{'rules'}");
- join("\n", @s, '');
-}
-
-1;
-
-
-__END__
-
-=pod
-
-=head1 NAME
-
-LWP::RobotUA - a class for well-behaved Web robots
-
-=head1 SYNOPSIS
-
- use LWP::RobotUA;
- my $ua = LWP::RobotUA->new('my-robot/0.1', 'me@foo.com');
- $ua->delay(10); # be very nice -- max one hit every ten minutes!
- ...
-
- # Then just use it just like a normal LWP::UserAgent:
- my $response = $ua->get('http://whatever.int/...');
- ...
-
-=head1 DESCRIPTION
-
-This class implements a user agent that is suitable for robot
-applications. Robots should be nice to the servers they visit. They
-should consult the F</robots.txt> file to ensure that they are welcomed
-and they should not make requests too frequently.
-
-But before you consider writing a robot, take a look at
-L<http://www.robotstxt.org/>.
-
-When you use an I<LWP::RobotUA> object as your user agent, then you do not
-really have to think about these things yourself; C<robots.txt> files
-are automatically consulted and obeyed, the server isn't queried
-too rapidly, and so on. Just send requests
-as you do when you are using a normal I<LWP::UserAgent>
-object (using C<< $ua->get(...) >>, C<< $ua->head(...) >>,
-C<< $ua->request(...) >>, etc.), and this
-special agent will make sure you are nice.
-
-=head1 METHODS
-
-The LWP::RobotUA is a sub-class of L<LWP::UserAgent> and implements the
-same methods. In addition the following methods are provided:
-
-=head2 new
-
- my $ua = LWP::RobotUA->new( %options )
- my $ua = LWP::RobotUA->new( $agent, $from )
- my $ua = LWP::RobotUA->new( $agent, $from, $rules )
-
-The LWP::UserAgent options C<agent> and C<from> are mandatory. The
-options C<delay>, C<use_sleep> and C<rules> initialize attributes
-private to the RobotUA. If C<rules> are not provided, then
-L<WWW::RobotRules> is instantiated providing an internal database of
-F<robots.txt>.
-
-It is also possible to just pass the value of C<agent>, C<from> and
-optionally C<rules> as plain positional arguments.
-
-=head2 delay
-
- my $delay = $ua->delay;
- $ua->delay( $minutes );
-
-Get/set the minimum delay between requests to the same server, in
-I<minutes>. The default is C<1> minute. Note that this number doesn't
-have to be an integer; for example, this sets the delay to C<10> seconds:
-
- $ua->delay(10/60);
-
-=head2 use_sleep
-
- my $bool = $ua->use_sleep;
- $ua->use_sleep( $boolean );
-
-Get/set a value indicating whether the UA should L<LWP::RobotUA/sleep> if
-requests arrive too fast, defined as C<< $ua->delay >> minutes not passed since
-last request to the given server. The default is true. If this value is
-false then an internal C<SERVICE_UNAVAILABLE> response will be generated.
-It will have a C<Retry-After> header that indicates when it is OK to
-send another request to this server.
-
-=head2 rules
-
- my $rules = $ua->rules;
- $ua->rules( $rules );
-
-Set/get which I<WWW::RobotRules> object to use.
-
-=head2 no_visits
-
- my $num = $ua->no_visits( $netloc )
-
-Returns the number of documents fetched from this server host. Yeah I
-know, this method should probably have been named C<num_visits> or
-something like that. :-(
-
-=head2 host_wait
-
- my $num = $ua->host_wait( $netloc )
-
-Returns the number of I<seconds> (from now) you must wait before you can
-make a new request to this host.
-
-=head2 as_string
-
- my $string = $ua->as_string;
-
-Returns a string that describes the state of the UA.
-Mainly useful for debugging.
-
-=head1 SEE ALSO
-
-L<LWP::UserAgent>, L<WWW::RobotRules>
-
-=head1 COPYRIGHT
-
-Copyright 1996-2004 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Simple.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Simple.pm
deleted file mode 100644
index d76d6afdfd..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Simple.pm
+++ /dev/null
@@ -1,267 +0,0 @@
-package LWP::Simple;
-
-use strict;
-
-our $VERSION = '6.61';
-
-require Exporter;
-
-our @EXPORT = qw(get head getprint getstore mirror);
-our @EXPORT_OK = qw($ua);
-
-# I really hate this. It was a bad idea to do it in the first place.
-# Wonder how to get rid of it??? (It even makes LWP::Simple 7% slower
-# for trivial tests)
-use HTTP::Status;
-push(@EXPORT, @HTTP::Status::EXPORT);
-
-sub import
-{
- my $pkg = shift;
- my $callpkg = caller;
- Exporter::export($pkg, $callpkg, @_);
-}
-
-use LWP::UserAgent ();
-use HTTP::Date ();
-
-our $ua = LWP::UserAgent->new; # we create a global UserAgent object
-$ua->agent("LWP::Simple/$VERSION ");
-$ua->env_proxy;
-
-sub get ($)
-{
- my $response = $ua->get(shift);
- return $response->decoded_content if $response->is_success;
- return undef;
-}
-
-
-sub head ($)
-{
- my($url) = @_;
- my $request = HTTP::Request->new(HEAD => $url);
- my $response = $ua->request($request);
-
- if ($response->is_success) {
- return $response unless wantarray;
- return (scalar $response->header('Content-Type'),
- scalar $response->header('Content-Length'),
- HTTP::Date::str2time($response->header('Last-Modified')),
- HTTP::Date::str2time($response->header('Expires')),
- scalar $response->header('Server'),
- );
- }
- return;
-}
-
-
-sub getprint ($)
-{
- my($url) = @_;
- my $request = HTTP::Request->new(GET => $url);
- local($\) = ""; # ensure standard $OUTPUT_RECORD_SEPARATOR
- my $callback = sub { print $_[0] };
- if ($^O eq "MacOS") {
- $callback = sub { $_[0] =~ s/\015?\012/\n/g; print $_[0] }
- }
- my $response = $ua->request($request, $callback);
- unless ($response->is_success) {
- print STDERR $response->status_line, " <URL:$url>\n";
- }
- $response->code;
-}
-
-
-sub getstore ($$)
-{
- my($url, $file) = @_;
- my $request = HTTP::Request->new(GET => $url);
- my $response = $ua->request($request, $file);
-
- $response->code;
-}
-
-
-sub mirror ($$)
-{
- my($url, $file) = @_;
- my $response = $ua->mirror($url, $file);
- $response->code;
-}
-
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-LWP::Simple - simple procedural interface to LWP
-
-=head1 SYNOPSIS
-
- perl -MLWP::Simple -e 'getprint "http://www.sn.no"'
-
- use LWP::Simple;
- $content = get("http://www.sn.no/");
- die "Couldn't get it!" unless defined $content;
-
- if (mirror("http://www.sn.no/", "foo") == RC_NOT_MODIFIED) {
- ...
- }
-
- if (is_success(getprint("http://www.sn.no/"))) {
- ...
- }
-
-=head1 DESCRIPTION
-
-This module is meant for people who want a simplified view of the
-libwww-perl library. It should also be suitable for one-liners. If
-you need more control or access to the header fields in the requests
-sent and responses received, then you should use the full object-oriented
-interface provided by the L<LWP::UserAgent> module.
-
-The module will also export the L<LWP::UserAgent> object as C<$ua> if you
-ask for it explicitly.
-
-The user agent created by this module will identify itself as
-C<LWP::Simple/#.##>
-and will initialize its proxy defaults from the environment (by
-calling C<< $ua->env_proxy >>).
-
-=head1 FUNCTIONS
-
-The following functions are provided (and exported) by this module:
-
-=head2 get
-
- my $res = get($url);
-
-The get() function will fetch the document identified by the given URL
-and return it. It returns C<undef> if it fails. The C<$url> argument can
-be either a string or a reference to a L<URI> object.
-
-You will not be able to examine the response code or response headers
-(like C<Content-Type>) when you are accessing the web using this
-function. If you need that information you should use the full OO
-interface (see L<LWP::UserAgent>).
-
-=head2 head
-
- my $res = head($url);
-
-Get document headers. Returns the following 5 values if successful:
-($content_type, $document_length, $modified_time, $expires, $server)
-
-Returns an empty list if it fails. In scalar context returns TRUE if
-successful.
-
-=head2 getprint
-
- my $code = getprint($url);
-
-Get and print a document identified by a URL. The document is printed
-to the selected default filehandle for output (normally STDOUT) as
-data is received from the network. If the request fails, then the
-status code and message are printed on STDERR. The return value is
-the HTTP response code.
-
-=head2 getstore
-
- my $code = getstore($url, $file)
-
-Gets a document identified by a URL and stores it in the file. The
-return value is the HTTP response code.
-
-=head2 mirror
-
- my $code = mirror($url, $file);
-
-Get and store a document identified by a URL, using
-I<If-modified-since>, and checking the I<Content-Length>. Returns
-the HTTP response code.
-
-=head1 STATUS CONSTANTS
-
-This module also exports the L<HTTP::Status> constants and procedures.
-You can use them when you check the response code from L<LWP::Simple/getprint>,
-L<LWP::Simple/getstore> or L<LWP::Simple/mirror>. The constants are:
-
- RC_CONTINUE
- RC_SWITCHING_PROTOCOLS
- RC_OK
- RC_CREATED
- RC_ACCEPTED
- RC_NON_AUTHORITATIVE_INFORMATION
- RC_NO_CONTENT
- RC_RESET_CONTENT
- RC_PARTIAL_CONTENT
- RC_MULTIPLE_CHOICES
- RC_MOVED_PERMANENTLY
- RC_MOVED_TEMPORARILY
- RC_SEE_OTHER
- RC_NOT_MODIFIED
- RC_USE_PROXY
- RC_BAD_REQUEST
- RC_UNAUTHORIZED
- RC_PAYMENT_REQUIRED
- RC_FORBIDDEN
- RC_NOT_FOUND
- RC_METHOD_NOT_ALLOWED
- RC_NOT_ACCEPTABLE
- RC_PROXY_AUTHENTICATION_REQUIRED
- RC_REQUEST_TIMEOUT
- RC_CONFLICT
- RC_GONE
- RC_LENGTH_REQUIRED
- RC_PRECONDITION_FAILED
- RC_REQUEST_ENTITY_TOO_LARGE
- RC_REQUEST_URI_TOO_LARGE
- RC_UNSUPPORTED_MEDIA_TYPE
- RC_INTERNAL_SERVER_ERROR
- RC_NOT_IMPLEMENTED
- RC_BAD_GATEWAY
- RC_SERVICE_UNAVAILABLE
- RC_GATEWAY_TIMEOUT
- RC_HTTP_VERSION_NOT_SUPPORTED
-
-=head1 CLASSIFICATION FUNCTIONS
-
-The L<HTTP::Status> classification functions are:
-
-=head2 is_success
-
- my $bool = is_success($rc);
-
-True if response code indicated a successful request.
-
-=head2 is_error
-
- my $bool = is_error($rc)
-
-True if response code indicated that an error occurred.
-
-=head1 CAVEAT
-
-Note that if you are using both LWP::Simple and the very popular L<CGI>
-module, you may be importing a C<head> function from each module,
-producing a warning like C<Prototype mismatch: sub main::head ($) vs none>.
-Get around this problem by just not importing LWP::Simple's
-C<head> function, like so:
-
- use LWP::Simple qw(!head);
- use CGI qw(:standard); # then only CGI.pm defines a head()
-
-Then if you do need LWP::Simple's C<head> function, you can just call
-it as C<LWP::Simple::head($url)>.
-
-=head1 SEE ALSO
-
-L<LWP>, L<lwpcook>, L<LWP::UserAgent>, L<HTTP::Status>, L<lwp-request>,
-L<lwp-mirror>
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/UserAgent.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/UserAgent.pm
deleted file mode 100644
index a521f16529..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/UserAgent.pm
+++ /dev/null
@@ -1,2179 +0,0 @@
-package LWP::UserAgent;
-
-use strict;
-
-use parent qw(LWP::MemberMixin);
-
-use Carp ();
-use File::Copy ();
-use HTTP::Request ();
-use HTTP::Response ();
-use HTTP::Date ();
-
-use LWP ();
-use HTTP::Status ();
-use LWP::Protocol ();
-
-use Scalar::Util qw(blessed);
-use Try::Tiny qw(try catch);
-
-our $VERSION = '6.61';
-
-sub new
-{
- # Check for common user mistake
- Carp::croak("Options to LWP::UserAgent should be key/value pairs, not hash reference")
- if ref($_[1]) eq 'HASH';
-
- my($class, %cnf) = @_;
-
- my $agent = delete $cnf{agent};
- my $from = delete $cnf{from};
- my $def_headers = delete $cnf{default_headers};
- my $timeout = delete $cnf{timeout};
- $timeout = 3*60 unless defined $timeout;
- my $local_address = delete $cnf{local_address};
- my $ssl_opts = delete $cnf{ssl_opts} || {};
- unless (exists $ssl_opts->{verify_hostname}) {
- # The processing of HTTPS_CA_* below is for compatibility with Crypt::SSLeay
- if (exists $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME}) {
- $ssl_opts->{verify_hostname} = $ENV{PERL_LWP_SSL_VERIFY_HOSTNAME};
- }
- elsif ($ENV{HTTPS_CA_FILE} || $ENV{HTTPS_CA_DIR}) {
- # Crypt-SSLeay compatibility (verify peer certificate; but not the hostname)
- $ssl_opts->{verify_hostname} = 0;
- $ssl_opts->{SSL_verify_mode} = 1;
- }
- else {
- $ssl_opts->{verify_hostname} = 1;
- }
- }
- unless (exists $ssl_opts->{SSL_ca_file}) {
- if (my $ca_file = $ENV{PERL_LWP_SSL_CA_FILE} || $ENV{HTTPS_CA_FILE}) {
- $ssl_opts->{SSL_ca_file} = $ca_file;
- }
- }
- unless (exists $ssl_opts->{SSL_ca_path}) {
- if (my $ca_path = $ENV{PERL_LWP_SSL_CA_PATH} || $ENV{HTTPS_CA_DIR}) {
- $ssl_opts->{SSL_ca_path} = $ca_path;
- }
- }
- my $use_eval = delete $cnf{use_eval};
- $use_eval = 1 unless defined $use_eval;
- my $parse_head = delete $cnf{parse_head};
- $parse_head = 1 unless defined $parse_head;
- my $send_te = delete $cnf{send_te};
- $send_te = 1 unless defined $send_te;
- my $show_progress = delete $cnf{show_progress};
- my $max_size = delete $cnf{max_size};
- my $max_redirect = delete $cnf{max_redirect};
- $max_redirect = 7 unless defined $max_redirect;
- my $env_proxy = exists $cnf{env_proxy} ? delete $cnf{env_proxy} : $ENV{PERL_LWP_ENV_PROXY};
- my $no_proxy = exists $cnf{no_proxy} ? delete $cnf{no_proxy} : [];
- Carp::croak(qq{no_proxy must be an arrayref, not $no_proxy!}) if ref $no_proxy ne 'ARRAY';
-
- my $cookie_jar = delete $cnf{cookie_jar};
- my $conn_cache = delete $cnf{conn_cache};
- my $keep_alive = delete $cnf{keep_alive};
-
- Carp::croak("Can't mix conn_cache and keep_alive")
- if $conn_cache && $keep_alive;
-
- my $protocols_allowed = delete $cnf{protocols_allowed};
- my $protocols_forbidden = delete $cnf{protocols_forbidden};
-
- my $requests_redirectable = delete $cnf{requests_redirectable};
- $requests_redirectable = ['GET', 'HEAD']
- unless defined $requests_redirectable;
-
- # Actually ""s are just as good as 0's, but for concision we'll just say:
- Carp::croak("protocols_allowed has to be an arrayref or 0, not \"$protocols_allowed\"!")
- if $protocols_allowed and ref($protocols_allowed) ne 'ARRAY';
- Carp::croak("protocols_forbidden has to be an arrayref or 0, not \"$protocols_forbidden\"!")
- if $protocols_forbidden and ref($protocols_forbidden) ne 'ARRAY';
- Carp::croak("requests_redirectable has to be an arrayref or 0, not \"$requests_redirectable\"!")
- if $requests_redirectable and ref($requests_redirectable) ne 'ARRAY';
-
- if (%cnf && $^W) {
- Carp::carp("Unrecognized LWP::UserAgent options: @{[sort keys %cnf]}");
- }
-
- my $self = bless {
- def_headers => $def_headers,
- timeout => $timeout,
- local_address => $local_address,
- ssl_opts => $ssl_opts,
- use_eval => $use_eval,
- show_progress => $show_progress,
- max_size => $max_size,
- max_redirect => $max_redirect,
- # We set proxy later as we do validation on the values
- proxy => {},
- no_proxy => [ @{ $no_proxy } ],
- protocols_allowed => $protocols_allowed,
- protocols_forbidden => $protocols_forbidden,
- requests_redirectable => $requests_redirectable,
- send_te => $send_te,
- }, $class;
-
- $self->agent(defined($agent) ? $agent : $class->_agent)
- if defined($agent) || !$def_headers || !$def_headers->header("User-Agent");
- $self->from($from) if $from;
- $self->cookie_jar($cookie_jar) if $cookie_jar;
- $self->parse_head($parse_head);
- $self->env_proxy if $env_proxy;
-
- if (exists $cnf{proxy}) {
- Carp::croak(qq{proxy must be an arrayref, not $cnf{proxy}!})
- if ref $cnf{proxy} ne 'ARRAY';
- $self->proxy($cnf{proxy});
- }
-
- $self->protocols_allowed( $protocols_allowed ) if $protocols_allowed;
- $self->protocols_forbidden($protocols_forbidden) if $protocols_forbidden;
-
- if ($keep_alive) {
- $conn_cache ||= { total_capacity => $keep_alive };
- }
- $self->conn_cache($conn_cache) if $conn_cache;
-
- return $self;
-}
-
-
-sub send_request
-{
- my($self, $request, $arg, $size) = @_;
- my($method, $url) = ($request->method, $request->uri);
- my $scheme = $url->scheme;
-
- local($SIG{__DIE__}); # protect against user defined die handlers
-
- $self->progress("begin", $request);
-
- my $response = $self->run_handlers("request_send", $request);
-
- unless ($response) {
- my $protocol;
-
- {
- # Honor object-specific restrictions by forcing protocol objects
- # into class LWP::Protocol::nogo.
- my $x;
- if($x = $self->protocols_allowed) {
- if (grep lc($_) eq $scheme, @$x) {
- }
- else {
- require LWP::Protocol::nogo;
- $protocol = LWP::Protocol::nogo->new;
- }
- }
- elsif ($x = $self->protocols_forbidden) {
- if(grep lc($_) eq $scheme, @$x) {
- require LWP::Protocol::nogo;
- $protocol = LWP::Protocol::nogo->new;
- }
- }
- # else fall thru and create the protocol object normally
- }
-
- # Locate protocol to use
- my $proxy = $request->{proxy};
- if ($proxy) {
- $scheme = $proxy->scheme;
- }
-
- unless ($protocol) {
- try {
- $protocol = LWP::Protocol::create($scheme, $self);
- }
- catch {
- my $error = $_;
- $error =~ s/ at .* line \d+.*//s; # remove file/line number
- $response = _new_response($request, HTTP::Status::RC_NOT_IMPLEMENTED, $error);
- if ($scheme eq "https") {
- $response->message($response->message . " (LWP::Protocol::https not installed)");
- $response->content_type("text/plain");
- $response->content(<<EOT);
-LWP will support https URLs if the LWP::Protocol::https module
-is installed.
-EOT
- }
- };
- }
-
- if (!$response && $self->{use_eval}) {
- # we eval, and turn dies into responses below
- try {
- $response = $protocol->request($request, $proxy, $arg, $size, $self->{timeout}) || die "No response returned by $protocol";
- }
- catch {
- my $error = $_;
- if (blessed($error) && $error->isa("HTTP::Response")) {
- $response = $error;
- $response->request($request);
- }
- else {
- my $full = $error;
- (my $status = $error) =~ s/\n.*//s;
- $status =~ s/ at .* line \d+.*//s; # remove file/line number
- my $code = ($status =~ s/^(\d\d\d)\s+//) ? $1 : HTTP::Status::RC_INTERNAL_SERVER_ERROR;
- $response = _new_response($request, $code, $status, $full);
- }
- };
- }
- elsif (!$response) {
- $response = $protocol->request($request, $proxy,
- $arg, $size, $self->{timeout});
- # XXX: Should we die unless $response->is_success ???
- }
- }
-
- $response->request($request); # record request for reference
- $response->header("Client-Date" => HTTP::Date::time2str(time));
-
- $self->run_handlers("response_done", $response);
-
- $self->progress("end", $response);
- return $response;
-}
-
-
-sub prepare_request
-{
- my($self, $request) = @_;
- die "Method missing" unless $request->method;
- my $url = $request->uri;
- die "URL missing" unless $url;
- die "URL must be absolute" unless $url->scheme;
-
- $self->run_handlers("request_preprepare", $request);
-
- if (my $def_headers = $self->{def_headers}) {
- for my $h ($def_headers->header_field_names) {
- $request->init_header($h => [$def_headers->header($h)]);
- }
- }
-
- $self->run_handlers("request_prepare", $request);
-
- return $request;
-}
-
-
-sub simple_request
-{
- my($self, $request, $arg, $size) = @_;
-
- # sanity check the request passed in
- if (defined $request) {
- if (ref $request) {
- Carp::croak("You need a request object, not a " . ref($request) . " object")
- if ref($request) eq 'ARRAY' or ref($request) eq 'HASH' or
- !$request->can('method') or !$request->can('uri');
- }
- else {
- Carp::croak("You need a request object, not '$request'");
- }
- }
- else {
- Carp::croak("No request object passed in");
- }
-
- my $error;
- try {
- $request = $self->prepare_request($request);
- }
- catch {
- $error = $_;
- $error =~ s/ at .* line \d+.*//s; # remove file/line number
- };
-
- if ($error) {
- return _new_response($request, HTTP::Status::RC_BAD_REQUEST, $error);
- }
- return $self->send_request($request, $arg, $size);
-}
-
-
-sub request {
- my ($self, $request, $arg, $size, $previous) = @_;
-
- my $response = $self->simple_request($request, $arg, $size);
- $response->previous($previous) if $previous;
-
- if ($response->redirects >= $self->{max_redirect}) {
- if ($response->header('Location')) {
- $response->header("Client-Warning" =>
- "Redirect loop detected (max_redirect = $self->{max_redirect})"
- );
- }
- return $response;
- }
-
- if (my $req = $self->run_handlers("response_redirect", $response)) {
- return $self->request($req, $arg, $size, $response);
- }
-
- my $code = $response->code;
-
- if ( $code == HTTP::Status::RC_MOVED_PERMANENTLY
- or $code == HTTP::Status::RC_FOUND
- or $code == HTTP::Status::RC_SEE_OTHER
- or $code == HTTP::Status::RC_TEMPORARY_REDIRECT
- or $code == HTTP::Status::RC_PERMANENT_REDIRECT)
- {
- my $referral = $request->clone;
-
- # These headers should never be forwarded
- $referral->remove_header('Host', 'Cookie');
-
- if ( $referral->header('Referer')
- && $request->uri->scheme eq 'https'
- && $referral->uri->scheme eq 'http')
- {
- # RFC 2616, section 15.1.3.
- # https -> http redirect, suppressing Referer
- $referral->remove_header('Referer');
- }
-
- if ( $code == HTTP::Status::RC_SEE_OTHER
- || $code == HTTP::Status::RC_FOUND)
- {
- my $method = uc($referral->method);
- unless ($method eq "GET" || $method eq "HEAD") {
- $referral->method("GET");
- $referral->content("");
- $referral->remove_content_headers;
- }
- }
-
- # And then we update the URL based on the Location:-header.
- my $referral_uri = $response->header('Location');
- {
- # Some servers erroneously return a relative URL for redirects,
- # so make it absolute if it not already is.
- local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
- my $base = $response->base;
- $referral_uri = "" unless defined $referral_uri;
- $referral_uri
- = $HTTP::URI_CLASS->new($referral_uri, $base)->abs($base);
- }
- $referral->uri($referral_uri);
-
- return $response unless $self->redirect_ok($referral, $response);
- return $self->request($referral, $arg, $size, $response);
-
- }
- elsif ($code == HTTP::Status::RC_UNAUTHORIZED
- || $code == HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED)
- {
- my $proxy = ($code == HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED);
- my $ch_header
- = $proxy || $request->method eq 'CONNECT'
- ? "Proxy-Authenticate"
- : "WWW-Authenticate";
- my @challenges = $response->header($ch_header);
- unless (@challenges) {
- $response->header(
- "Client-Warning" => "Missing Authenticate header");
- return $response;
- }
-
- require HTTP::Headers::Util;
- CHALLENGE: for my $challenge (@challenges) {
- $challenge =~ tr/,/;/; # "," is used to separate auth-params!!
- ($challenge) = HTTP::Headers::Util::split_header_words($challenge);
- my $scheme = shift(@$challenge);
- shift(@$challenge); # no value
- $challenge = {@$challenge}; # make rest into a hash
-
- unless ($scheme =~ /^([a-z]+(?:-[a-z]+)*)$/) {
- $response->header(
- "Client-Warning" => "Bad authentication scheme '$scheme'");
- return $response;
- }
- $scheme = $1; # untainted now
- my $class = "LWP::Authen::\u$scheme";
- $class =~ tr/-/_/;
-
- no strict 'refs';
- unless (%{"$class\::"}) {
- # try to load it
- my $error;
- try {
- (my $req = $class) =~ s{::}{/}g;
- $req .= '.pm' unless $req =~ /\.pm$/;
- require $req;
- }
- catch {
- $error = $_;
- };
- if ($error) {
- if ($error =~ /^Can\'t locate/) {
- $response->header("Client-Warning" =>
- "Unsupported authentication scheme '$scheme'");
- }
- else {
- $response->header("Client-Warning" => $error);
- }
- next CHALLENGE;
- }
- }
- unless ($class->can("authenticate")) {
- $response->header("Client-Warning" =>
- "Unsupported authentication scheme '$scheme'");
- next CHALLENGE;
- }
- my $re = $class->authenticate($self, $proxy, $challenge, $response,
- $request, $arg, $size);
-
- next CHALLENGE if $re->code == HTTP::Status::RC_UNAUTHORIZED;
- return $re;
- }
- return $response;
- }
- return $response;
-}
-
-#
-# Now the shortcuts...
-#
-sub get {
- require HTTP::Request::Common;
- my($self, @parameters) = @_;
- my @suff = $self->_process_colonic_headers(\@parameters,1);
- return $self->request( HTTP::Request::Common::GET( @parameters ), @suff );
-}
-
-sub _maybe_copy_default_content_type {
- my $self = shift;
- my $req = shift;
-
- my $default_ct = $self->default_header('Content-Type');
- return unless defined $default_ct;
-
- # drop url
- shift;
-
- # adapted from HTTP::Request::Common::request_type_with_data
- my $content;
- $content = shift if @_ and ref $_[0];
-
- # We only care about the final value, really
- my $ct;
-
- my ($k, $v);
- while (($k, $v) = splice(@_, 0, 2)) {
- if (lc($k) eq 'content') {
- $content = $v;
- }
- elsif (lc($k) eq 'content-type') {
- $ct = $v;
- }
- }
-
- # Content-type provided and truthy? skip
- return if $ct;
-
- # Content is not just a string? Then it must be x-www-form-urlencoded
- return if defined $content && ref($content);
-
- # Provide default
- $req->header('Content-Type' => $default_ct);
-}
-
-sub post {
- require HTTP::Request::Common;
- my($self, @parameters) = @_;
- my @suff = $self->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
- my $req = HTTP::Request::Common::POST(@parameters);
- $self->_maybe_copy_default_content_type($req, @parameters);
- return $self->request($req, @suff);
-}
-
-
-sub head {
- require HTTP::Request::Common;
- my($self, @parameters) = @_;
- my @suff = $self->_process_colonic_headers(\@parameters,1);
- return $self->request( HTTP::Request::Common::HEAD( @parameters ), @suff );
-}
-
-sub patch {
- require HTTP::Request::Common;
- my($self, @parameters) = @_;
- my @suff = $self->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
-
- # this work-around is in place as HTTP::Request::Common
- # did not implement a patch convenience method until
- # version 6.12. Once we can bump the prereq to at least
- # that version, we can use ::PATCH instead of this hack
- my $req = HTTP::Request::Common::PUT(@parameters);
- $req->method('PATCH');
-
- $self->_maybe_copy_default_content_type($req, @parameters);
- return $self->request($req, @suff);
-}
-
-sub put {
- require HTTP::Request::Common;
- my($self, @parameters) = @_;
- my @suff = $self->_process_colonic_headers(\@parameters, (ref($parameters[1]) ? 2 : 1));
- my $req = HTTP::Request::Common::PUT(@parameters);
- $self->_maybe_copy_default_content_type($req, @parameters);
- return $self->request($req, @suff);
-}
-
-
-sub delete {
- require HTTP::Request::Common;
- my($self, @parameters) = @_;
- my @suff = $self->_process_colonic_headers(\@parameters,1);
- return $self->request( HTTP::Request::Common::DELETE( @parameters ), @suff );
-}
-
-
-sub _process_colonic_headers {
- # Process :content_cb / :content_file / :read_size_hint headers.
- my($self, $args, $start_index) = @_;
-
- my($arg, $size);
- for(my $i = $start_index; $i < @$args; $i += 2) {
- next unless defined $args->[$i];
-
- #printf "Considering %s => %s\n", $args->[$i], $args->[$i + 1];
-
- if($args->[$i] eq ':content_cb') {
- # Some sanity-checking...
- $arg = $args->[$i + 1];
- Carp::croak("A :content_cb value can't be undef") unless defined $arg;
- Carp::croak("A :content_cb value must be a coderef")
- unless ref $arg and UNIVERSAL::isa($arg, 'CODE');
-
- }
- elsif ($args->[$i] eq ':content_file') {
- $arg = $args->[$i + 1];
-
- # Some sanity-checking...
- Carp::croak("A :content_file value can't be undef")
- unless defined $arg;
- Carp::croak("A :content_file value can't be a reference")
- if ref $arg;
- Carp::croak("A :content_file value can't be \"\"")
- unless length $arg;
-
- }
- elsif ($args->[$i] eq ':read_size_hint') {
- $size = $args->[$i + 1];
- # Bother checking it?
-
- }
- else {
- next;
- }
- splice @$args, $i, 2;
- $i -= 2;
- }
-
- # And return a suitable suffix-list for request(REQ,...)
-
- return unless defined $arg;
- return $arg, $size if defined $size;
- return $arg;
-}
-
-
-sub is_online {
- my $self = shift;
- return 1 if $self->get("http://www.msftncsi.com/ncsi.txt")->content eq "Microsoft NCSI";
- return 1 if $self->get("http://www.apple.com")->content =~ m,<title>Apple</title>,;
- return 0;
-}
-
-
-my @ANI = qw(- \ | /);
-
-sub progress {
- my($self, $status, $m) = @_;
- return unless $self->{show_progress};
-
- local($,, $\);
- if ($status eq "begin") {
- print STDERR "** ", $m->method, " ", $m->uri, " ==> ";
- $self->{progress_start} = time;
- $self->{progress_lastp} = "";
- $self->{progress_ani} = 0;
- }
- elsif ($status eq "end") {
- delete $self->{progress_lastp};
- delete $self->{progress_ani};
- print STDERR $m->status_line;
- my $t = time - delete $self->{progress_start};
- print STDERR " (${t}s)" if $t;
- print STDERR "\n";
- }
- elsif ($status eq "tick") {
- print STDERR "$ANI[$self->{progress_ani}++]\b";
- $self->{progress_ani} %= @ANI;
- }
- else {
- my $p = sprintf "%3.0f%%", $status * 100;
- return if $p eq $self->{progress_lastp};
- print STDERR "$p\b\b\b\b";
- $self->{progress_lastp} = $p;
- }
- STDERR->flush;
-}
-
-
-#
-# This whole allow/forbid thing is based on man 1 at's way of doing things.
-#
-sub is_protocol_supported
-{
- my($self, $scheme) = @_;
- if (ref $scheme) {
- # assume we got a reference to an URI object
- $scheme = $scheme->scheme;
- }
- else {
- Carp::croak("Illegal scheme '$scheme' passed to is_protocol_supported")
- if $scheme =~ /\W/;
- $scheme = lc $scheme;
- }
-
- my $x;
- if(ref($self) and $x = $self->protocols_allowed) {
- return 0 unless grep lc($_) eq $scheme, @$x;
- }
- elsif (ref($self) and $x = $self->protocols_forbidden) {
- return 0 if grep lc($_) eq $scheme, @$x;
- }
-
- local($SIG{__DIE__}); # protect against user defined die handlers
- $x = LWP::Protocol::implementor($scheme);
- return 1 if $x and $x ne 'LWP::Protocol::nogo';
- return 0;
-}
-
-
-sub protocols_allowed { shift->_elem('protocols_allowed' , @_) }
-sub protocols_forbidden { shift->_elem('protocols_forbidden' , @_) }
-sub requests_redirectable { shift->_elem('requests_redirectable', @_) }
-
-
-sub redirect_ok
-{
- # RFC 2616, section 10.3.2 and 10.3.3 say:
- # If the 30[12] status code is received in response to a request other
- # than GET or HEAD, the user agent MUST NOT automatically redirect the
- # request unless it can be confirmed by the user, since this might
- # change the conditions under which the request was issued.
-
- # Note that this routine used to be just:
- # return 0 if $_[1]->method eq "POST"; return 1;
-
- my($self, $new_request, $response) = @_;
- my $method = $response->request->method;
- return 0 unless grep $_ eq $method,
- @{ $self->requests_redirectable || [] };
-
- if ($new_request->uri->scheme eq 'file') {
- $response->header("Client-Warning" =>
- "Can't redirect to a file:// URL!");
- return 0;
- }
-
- # Otherwise it's apparently okay...
- return 1;
-}
-
-sub credentials {
- my $self = shift;
- my $netloc = lc(shift || '');
- my $realm = shift || "";
- my $old = $self->{basic_authentication}{$netloc}{$realm};
- if (@_) {
- $self->{basic_authentication}{$netloc}{$realm} = [@_];
- }
- return unless $old;
- return @$old if wantarray;
- return join(":", @$old);
-}
-
-sub get_basic_credentials
-{
- my($self, $realm, $uri, $proxy) = @_;
- return if $proxy;
- return $self->credentials($uri->host_port, $realm);
-}
-
-
-sub timeout { shift->_elem('timeout', @_); }
-sub local_address{ shift->_elem('local_address',@_); }
-sub max_size { shift->_elem('max_size', @_); }
-sub max_redirect { shift->_elem('max_redirect', @_); }
-sub show_progress{ shift->_elem('show_progress', @_); }
-sub send_te { shift->_elem('send_te', @_); }
-
-sub ssl_opts {
- my $self = shift;
- if (@_ == 1) {
- my $k = shift;
- return $self->{ssl_opts}{$k};
- }
- if (@_) {
- my $old;
- while (@_) {
- my($k, $v) = splice(@_, 0, 2);
- $old = $self->{ssl_opts}{$k} unless @_;
- if (defined $v) {
- $self->{ssl_opts}{$k} = $v;
- }
- else {
- delete $self->{ssl_opts}{$k};
- }
- }
- %{$self->{ssl_opts}} = (%{$self->{ssl_opts}}, @_);
- return $old;
- }
-
- my @opts= sort keys %{$self->{ssl_opts}};
- return @opts;
-}
-
-sub parse_head {
- my $self = shift;
- if (@_) {
- my $flag = shift;
- my $parser;
- my $old = $self->set_my_handler("response_header", $flag ? sub {
- my($response, $ua) = @_;
- require HTML::HeadParser;
- $parser = HTML::HeadParser->new;
- $parser->xml_mode(1) if $response->content_is_xhtml;
- $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40;
-
- push(@{$response->{handlers}{response_data}}, {
- callback => sub {
- return unless $parser;
- unless ($parser->parse($_[3])) {
- my $h = $parser->header;
- my $r = $_[0];
- for my $f ($h->header_field_names) {
- $r->init_header($f, [$h->header($f)]);
- }
- undef($parser);
- }
- },
- });
-
- } : undef,
- m_media_type => "html",
- );
- return !!$old;
- }
- else {
- return !!$self->get_my_handler("response_header");
- }
-}
-
-sub cookie_jar {
- my $self = shift;
- my $old = $self->{cookie_jar};
- if (@_) {
- my $jar = shift;
- if (ref($jar) eq "HASH") {
- require HTTP::Cookies;
- $jar = HTTP::Cookies->new(%$jar);
- }
- $self->{cookie_jar} = $jar;
- $self->set_my_handler("request_prepare",
- $jar ? sub {
- return if $_[0]->header("Cookie");
- $jar->add_cookie_header($_[0]);
- } : undef,
- );
- $self->set_my_handler("response_done",
- $jar ? sub { $jar->extract_cookies($_[0]); } : undef,
- );
- }
- $old;
-}
-
-sub default_headers {
- my $self = shift;
- my $old = $self->{def_headers} ||= HTTP::Headers->new;
- if (@_) {
- Carp::croak("default_headers not set to HTTP::Headers compatible object")
- unless @_ == 1 && $_[0]->can("header_field_names");
- $self->{def_headers} = shift;
- }
- return $old;
-}
-
-sub default_header {
- my $self = shift;
- return $self->default_headers->header(@_);
-}
-
-sub _agent { "libwww-perl/$VERSION" }
-
-sub agent {
- my $self = shift;
- if (@_) {
- my $agent = shift;
- if ($agent) {
- $agent .= $self->_agent if $agent =~ /\s+$/;
- }
- else {
- undef($agent)
- }
- return $self->default_header("User-Agent", $agent);
- }
- return $self->default_header("User-Agent");
-}
-
-sub from { # legacy
- my $self = shift;
- return $self->default_header("From", @_);
-}
-
-
-sub conn_cache {
- my $self = shift;
- my $old = $self->{conn_cache};
- if (@_) {
- my $cache = shift;
- if (ref($cache) eq "HASH") {
- require LWP::ConnCache;
- $cache = LWP::ConnCache->new(%$cache);
- }
- $self->{conn_cache} = $cache;
- }
- $old;
-}
-
-
-sub add_handler {
- my($self, $phase, $cb, %spec) = @_;
- $spec{line} ||= join(":", (caller)[1,2]);
- my $conf = $self->{handlers}{$phase} ||= do {
- require HTTP::Config;
- HTTP::Config->new;
- };
- $conf->add(%spec, callback => $cb);
-}
-
-sub set_my_handler {
- my($self, $phase, $cb, %spec) = @_;
- $spec{owner} = (caller(1))[3] unless exists $spec{owner};
- $self->remove_handler($phase, %spec);
- $spec{line} ||= join(":", (caller)[1,2]);
- $self->add_handler($phase, $cb, %spec) if $cb;
-}
-
-sub get_my_handler {
- my $self = shift;
- my $phase = shift;
- my $init = pop if @_ % 2;
- my %spec = @_;
- my $conf = $self->{handlers}{$phase};
- unless ($conf) {
- return unless $init;
- require HTTP::Config;
- $conf = $self->{handlers}{$phase} = HTTP::Config->new;
- }
- $spec{owner} = (caller(1))[3] unless exists $spec{owner};
- my @h = $conf->find(%spec);
- if (!@h && $init) {
- if (ref($init) eq "CODE") {
- $init->(\%spec);
- }
- elsif (ref($init) eq "HASH") {
- $spec{$_}= $init->{$_}
- for keys %$init;
- }
- $spec{callback} ||= sub {};
- $spec{line} ||= join(":", (caller)[1,2]);
- $conf->add(\%spec);
- return \%spec;
- }
- return wantarray ? @h : $h[0];
-}
-
-sub remove_handler {
- my($self, $phase, %spec) = @_;
- if ($phase) {
- my $conf = $self->{handlers}{$phase} || return;
- my @h = $conf->remove(%spec);
- delete $self->{handlers}{$phase} if $conf->empty;
- return @h;
- }
-
- return unless $self->{handlers};
- return map $self->remove_handler($_), sort keys %{$self->{handlers}};
-}
-
-sub handlers {
- my($self, $phase, $o) = @_;
- my @h;
- if ($o->{handlers} && $o->{handlers}{$phase}) {
- push(@h, @{$o->{handlers}{$phase}});
- }
- if (my $conf = $self->{handlers}{$phase}) {
- push(@h, $conf->matching($o));
- }
- return @h;
-}
-
-sub run_handlers {
- my($self, $phase, $o) = @_;
-
- # here we pass $_[2] to the callbacks, instead of $o, so that they
- # can assign to it; e.g. request_prepare is documented to allow
- # that
- if (defined(wantarray)) {
- for my $h ($self->handlers($phase, $o)) {
- my $ret = $h->{callback}->($_[2], $self, $h);
- return $ret if $ret;
- }
- return undef;
- }
-
- for my $h ($self->handlers($phase, $o)) {
- $h->{callback}->($_[2], $self, $h);
- }
-}
-
-
-# deprecated
-sub use_eval { shift->_elem('use_eval', @_); }
-sub use_alarm
-{
- Carp::carp("LWP::UserAgent->use_alarm(BOOL) is a no-op")
- if @_ > 1 && $^W;
- "";
-}
-
-
-sub clone
-{
- my $self = shift;
- my $copy = bless { %$self }, ref $self; # copy most fields
-
- delete $copy->{handlers};
- delete $copy->{conn_cache};
-
- # copy any plain arrays and hashes; known not to need recursive copy
- for my $k (qw(proxy no_proxy requests_redirectable ssl_opts)) {
- next unless $copy->{$k};
- if (ref($copy->{$k}) eq "ARRAY") {
- $copy->{$k} = [ @{$copy->{$k}} ];
- }
- elsif (ref($copy->{$k}) eq "HASH") {
- $copy->{$k} = { %{$copy->{$k}} };
- }
- }
-
- if ($self->{def_headers}) {
- $copy->{def_headers} = $self->{def_headers}->clone;
- }
-
- # re-enable standard handlers
- $copy->parse_head($self->parse_head);
-
- # no easy way to clone the cookie jar; so let's just remove it for now
- $copy->cookie_jar(undef);
-
- $copy;
-}
-
-
-sub mirror
-{
- my($self, $url, $file) = @_;
-
- die "Local file name is missing" unless defined $file && length $file;
-
- my $request = HTTP::Request->new('GET', $url);
-
- # If the file exists, add a cache-related header
- if ( -e $file ) {
- my ($mtime) = ( stat($file) )[9];
- if ($mtime) {
- $request->header( 'If-Modified-Since' => HTTP::Date::time2str($mtime) );
- }
- }
-
- require File::Temp;
- my ($tmpfh, $tmpfile) = File::Temp::tempfile("$file-XXXXXX");
- close($tmpfh) or die "Could not close tmpfile '$tmpfile': $!";
-
- my $response = $self->request($request, $tmpfile);
- if ( $response->header('X-Died') ) {
- unlink($tmpfile);
- die $response->header('X-Died');
- }
-
- # Only fetching a fresh copy of the file would be considered success.
- # If the file was not modified, "304" would returned, which
- # is considered by HTTP::Status to be a "redirect", /not/ "success"
- if ( $response->is_success ) {
- my @stat = stat($tmpfile) or die "Could not stat tmpfile '$tmpfile': $!";
- my $file_length = $stat[7];
- my ($content_length) = $response->header('Content-length');
-
- if ( defined $content_length and $file_length < $content_length ) {
- unlink($tmpfile);
- die "Transfer truncated: only $file_length out of $content_length bytes received\n";
- }
- elsif ( defined $content_length and $file_length > $content_length ) {
- unlink($tmpfile);
- die "Content-length mismatch: expected $content_length bytes, got $file_length\n";
- }
- # The file was the expected length.
- else {
- # Replace the stale file with a fresh copy
- # File::Copy will attempt to do it atomically,
- # and fall back to a delete + copy if that fails.
- File::Copy::move( $tmpfile, $file )
- or die "Cannot rename '$tmpfile' to '$file': $!\n";
-
- # Set standard file permissions if umask is supported.
- # If not, leave what File::Temp created in effect.
- if ( defined(my $umask = umask()) ) {
- my $mode = 0666 &~ $umask;
- chmod $mode, $file
- or die sprintf("Cannot chmod %o '%s': %s\n", $mode, $file, $!);
- }
-
- # make sure the file has the same last modification time
- if ( my $lm = $response->last_modified ) {
- utime $lm, $lm, $file
- or warn "Cannot update modification time of '$file': $!\n";
- }
- }
- }
- # The local copy is fresh enough, so just delete the temp file
- else {
- unlink($tmpfile);
- }
- return $response;
-}
-
-
-sub _need_proxy {
- my($req, $ua) = @_;
- return if exists $req->{proxy};
- my $proxy = $ua->{proxy}{$req->uri->scheme} || return;
- if ($ua->{no_proxy}) {
- if (my $host = eval { $req->uri->host }) {
- for my $domain (@{$ua->{no_proxy}}) {
- if ($host =~ /\Q$domain\E$/) {
- return;
- }
- }
- }
- }
- $req->{proxy} = $HTTP::URI_CLASS->new($proxy);
-}
-
-
-sub proxy {
- my $self = shift;
- my $key = shift;
- if (!@_ && ref $key eq 'ARRAY') {
- die 'odd number of items in proxy arrayref!' unless @{$key} % 2 == 0;
-
- # This map reads the elements of $key 2 at a time
- return
- map { $self->proxy($key->[2 * $_], $key->[2 * $_ + 1]) }
- (0 .. @{$key} / 2 - 1);
- }
- return map { $self->proxy($_, @_) } @$key if ref $key;
-
- Carp::croak("'$key' is not a valid URI scheme") unless $key =~ /^$URI::scheme_re\z/;
- my $old = $self->{'proxy'}{$key};
- if (@_) {
- my $url = shift;
- if (defined($url) && length($url)) {
- Carp::croak("Proxy must be specified as absolute URI; '$url' is not") unless $url =~ /^$URI::scheme_re:/;
- Carp::croak("Bad http proxy specification '$url'") if $url =~ /^https?:/ && $url !~ m,^https?://[\w[],;
- }
- $self->{proxy}{$key} = $url;
- $self->set_my_handler("request_preprepare", \&_need_proxy)
- }
- return $old;
-}
-
-
-sub env_proxy {
- my ($self) = @_;
- require Encode;
- require Encode::Locale;
- my $env_request_method= $ENV{REQUEST_METHOD};
- my %seen;
- foreach my $k (sort keys %ENV) {
- my $real_key= $k;
- my $v= $ENV{$k}
- or next;
- if ( $env_request_method ) {
- # Need to be careful when called in the CGI environment, as
- # the HTTP_PROXY variable is under control of that other guy.
- next if $k =~ /^HTTP_/;
- $k = "HTTP_PROXY" if $k eq "CGI_HTTP_PROXY";
- }
- $k = lc($k);
- if (my $from_key= $seen{$k}) {
- warn "Environment contains multiple differing definitions for '$k'.\n".
- "Using value from '$from_key' ($ENV{$from_key}) and ignoring '$real_key' ($v)"
- if $v ne $ENV{$from_key};
- next;
- } else {
- $seen{$k}= $real_key;
- }
-
- next unless $k =~ /^(.*)_proxy$/;
- $k = $1;
- if ($k eq 'no') {
- $self->no_proxy(split(/\s*,\s*/, $v));
- }
- else {
- # Ignore random _proxy variables, allow only valid schemes
- next unless $k =~ /^$URI::scheme_re\z/;
- # Ignore xxx_proxy variables if xxx isn't a supported protocol
- next unless LWP::Protocol::implementor($k);
- $self->proxy($k, Encode::decode(locale => $v));
- }
- }
-}
-
-
-sub no_proxy {
- my($self, @no) = @_;
- if (@no) {
- push(@{ $self->{'no_proxy'} }, @no);
- }
- else {
- $self->{'no_proxy'} = [];
- }
-}
-
-
-sub _new_response {
- my($request, $code, $message, $content) = @_;
- $message ||= HTTP::Status::status_message($code);
- my $response = HTTP::Response->new($code, $message);
- $response->request($request);
- $response->header("Client-Date" => HTTP::Date::time2str(time));
- $response->header("Client-Warning" => "Internal response");
- $response->header("Content-Type" => "text/plain");
- $response->content($content || "$code $message\n");
- return $response;
-}
-
-
-1;
-
-__END__
-
-=pod
-
-=head1 NAME
-
-LWP::UserAgent - Web user agent class
-
-=head1 SYNOPSIS
-
- use strict;
- use warnings;
-
- use LWP::UserAgent ();
-
- my $ua = LWP::UserAgent->new(timeout => 10);
- $ua->env_proxy;
-
- my $response = $ua->get('http://example.com');
-
- if ($response->is_success) {
- print $response->decoded_content;
- }
- else {
- die $response->status_line;
- }
-
-Extra layers of security (note the C<cookie_jar> and C<protocols_allowed>):
-
- use strict;
- use warnings;
-
- use HTTP::CookieJar::LWP ();
- use LWP::UserAgent ();
-
- my $jar = HTTP::CookieJar::LWP->new;
- my $ua = LWP::UserAgent->new(
- cookie_jar => $jar,
- protocols_allowed => ['http', 'https'],
- timeout => 10,
- );
-
- $ua->env_proxy;
-
- my $response = $ua->get('http://example.com');
-
- if ($response->is_success) {
- print $response->decoded_content;
- }
- else {
- die $response->status_line;
- }
-
-=head1 DESCRIPTION
-
-The L<LWP::UserAgent> is a class implementing a web user agent.
-L<LWP::UserAgent> objects can be used to dispatch web requests.
-
-In normal use the application creates an L<LWP::UserAgent> object, and
-then configures it with values for timeouts, proxies, name, etc. It
-then creates an instance of L<HTTP::Request> for the request that
-needs to be performed. This request is then passed to one of the
-request method the UserAgent, which dispatches it using the relevant
-protocol, and returns a L<HTTP::Response> object. There are
-convenience methods for sending the most common request types:
-L<LWP::UserAgent/get>, L<LWP::UserAgent/head>, L<LWP::UserAgent/post>,
-L<LWP::UserAgent/put> and L<LWP::UserAgent/delete>. When using these
-methods, the creation of the request object is hidden as shown in the
-synopsis above.
-
-The basic approach of the library is to use HTTP-style communication
-for all protocol schemes. This means that you will construct
-L<HTTP::Request> objects and receive L<HTTP::Response> objects even
-for non-HTTP resources like I<gopher> and I<ftp>. In order to achieve
-even more similarity to HTTP-style communications, I<gopher> menus and
-file directories are converted to HTML documents.
-
-=head1 CONSTRUCTOR METHODS
-
-The following constructor methods are available:
-
-=head2 clone
-
- my $ua2 = $ua->clone;
-
-Returns a copy of the L<LWP::UserAgent> object.
-
-B<CAVEAT>: Please be aware that the clone method does not copy or clone your
-C<cookie_jar> attribute. Due to the limited restrictions on what can be used
-for your cookie jar, there is no way to clone the attribute. The C<cookie_jar>
-attribute will be C<undef> in the new object instance.
-
-=head2 new
-
- my $ua = LWP::UserAgent->new( %options )
-
-This method constructs a new L<LWP::UserAgent> object and returns it.
-Key/value pair arguments may be provided to set up the initial state.
-The following options correspond to attribute methods described below:
-
- KEY DEFAULT
- ----------- --------------------
- agent "libwww-perl/#.###"
- conn_cache undef
- cookie_jar undef
- default_headers HTTP::Headers->new
- from undef
- local_address undef
- max_redirect 7
- max_size undef
- no_proxy []
- parse_head 1
- protocols_allowed undef
- protocols_forbidden undef
- proxy undef
- requests_redirectable ['GET', 'HEAD']
- ssl_opts { verify_hostname => 1 }
- timeout 180
-
-The following additional options are also accepted: If the C<env_proxy> option
-is passed in with a true value, then proxy settings are read from environment
-variables (see L<LWP::UserAgent/env_proxy>). If C<env_proxy> isn't provided, the
-C<PERL_LWP_ENV_PROXY> environment variable controls if
-L<LWP::UserAgent/env_proxy> is called during initialization. If the
-C<keep_alive> option value is defined and non-zero, then an C<LWP::ConnCache> is set up (see
-L<LWP::UserAgent/conn_cache>). The C<keep_alive> value is passed on as the
-C<total_capacity> for the connection cache.
-
-C<proxy> must be set as an arrayref of key/value pairs. C<no_proxy> takes an
-arrayref of domains.
-
-=head1 ATTRIBUTES
-
-The settings of the configuration attributes modify the behaviour of the
-L<LWP::UserAgent> when it dispatches requests. Most of these can also
-be initialized by options passed to the constructor method.
-
-The following attribute methods are provided. The attribute value is
-left unchanged if no argument is given. The return value from each
-method is the old attribute value.
-
-=head2 agent
-
- my $agent = $ua->agent;
- $ua->agent('Checkbot/0.4 '); # append the default to the end
- $ua->agent('Mozilla/5.0');
- $ua->agent(""); # don't identify
-
-Get/set the product token that is used to identify the user agent on
-the network. The agent value is sent as the C<User-Agent> header in
-the requests.
-
-The default is a string of the form C<libwww-perl/#.###>, where C<#.###> is
-substituted with the version number of this library.
-
-If the provided string ends with space, the default C<libwww-perl/#.###>
-string is appended to it.
-
-The user agent string should be one or more simple product identifiers
-with an optional version number separated by the C</> character.
-
-=head2 conn_cache
-
- my $cache_obj = $ua->conn_cache;
- $ua->conn_cache( $cache_obj );
-
-Get/set the L<LWP::ConnCache> object to use. See L<LWP::ConnCache>
-for details.
-
-=head2 cookie_jar
-
- my $jar = $ua->cookie_jar;
- $ua->cookie_jar( $cookie_jar_obj );
-
-Get/set the cookie jar object to use. The only requirement is that
-the cookie jar object must implement the C<extract_cookies($response)> and
-C<add_cookie_header($request)> methods. These methods will then be
-invoked by the user agent as requests are sent and responses are
-received. Normally this will be a L<HTTP::Cookies> object or some
-subclass. You are, however, encouraged to use L<HTTP::CookieJar::LWP>
-instead. See L</"BEST PRACTICES"> for more information.
-
- use HTTP::CookieJar::LWP ();
-
- my $jar = HTTP::CookieJar::LWP->new;
- my $ua = LWP::UserAgent->new( cookie_jar => $jar );
-
- # or after object creation
- $ua->cookie_jar( $cookie_jar );
-
-The default is to have no cookie jar, i.e. never automatically add
-C<Cookie> headers to the requests.
-
-Shortcut: If a reference to a plain hash is passed in, it is replaced with an
-instance of L<HTTP::Cookies> that is initialized based on the hash. This form
-also automatically loads the L<HTTP::Cookies> module. It means that:
-
- $ua->cookie_jar({ file => "$ENV{HOME}/.cookies.txt" });
-
-is really just a shortcut for:
-
- require HTTP::Cookies;
- $ua->cookie_jar(HTTP::Cookies->new(file => "$ENV{HOME}/.cookies.txt"));
-
-=head2 credentials
-
- my $creds = $ua->credentials();
- $ua->credentials( $netloc, $realm );
- $ua->credentials( $netloc, $realm, $uname, $pass );
- $ua->credentials("www.example.com:80", "Some Realm", "foo", "secret");
-
-Get/set the user name and password to be used for a realm.
-
-The C<$netloc> is a string of the form C<< <host>:<port> >>. The username and
-password will only be passed to this server.
-
-=head2 default_header
-
- $ua->default_header( $field );
- $ua->default_header( $field => $value );
- $ua->default_header('Accept-Encoding' => scalar HTTP::Message::decodable());
- $ua->default_header('Accept-Language' => "no, en");
-
-This is just a shortcut for
-C<< $ua->default_headers->header( $field => $value ) >>.
-
-=head2 default_headers
-
- my $headers = $ua->default_headers;
- $ua->default_headers( $headers_obj );
-
-Get/set the headers object that will provide default header values for
-any requests sent. By default this will be an empty L<HTTP::Headers>
-object.
-
-=head2 from
-
- my $from = $ua->from;
- $ua->from('foo@bar.com');
-
-Get/set the email address for the human user who controls
-the requesting user agent. The address should be machine-usable, as
-defined in L<RFC2822|https://tools.ietf.org/html/rfc2822>. The C<from> value
-is sent as the C<From> header in the requests.
-
-The default is to not send a C<From> header. See
-L<LWP::UserAgent/default_headers> for the more general interface that allow
-any header to be defaulted.
-
-
-=head2 local_address
-
- my $address = $ua->local_address;
- $ua->local_address( $address );
-
-Get/set the local interface to bind to for network connections. The interface
-can be specified as a hostname or an IP address. This value is passed as the
-C<LocalAddr> argument to L<IO::Socket::INET>.
-
-=head2 max_redirect
-
- my $max = $ua->max_redirect;
- $ua->max_redirect( $n );
-
-This reads or sets the object's limit of how many times it will obey
-redirection responses in a given request cycle.
-
-By default, the value is C<7>. This means that if you call L<LWP::UserAgent/request>
-and the response is a redirect elsewhere which is in turn a
-redirect, and so on seven times, then LWP gives up after that seventh
-request.
-
-=head2 max_size
-
- my $size = $ua->max_size;
- $ua->max_size( $bytes );
-
-Get/set the size limit for response content. The default is C<undef>,
-which means that there is no limit. If the returned response content
-is only partial, because the size limit was exceeded, then a
-C<Client-Aborted> header will be added to the response. The content
-might end up longer than C<max_size> as we abort once appending a
-chunk of data makes the length exceed the limit. The C<Content-Length>
-header, if present, will indicate the length of the full content and
-will normally not be the same as C<< length($res->content) >>.
-
-=head2 parse_head
-
- my $bool = $ua->parse_head;
- $ua->parse_head( $boolean );
-
-Get/set a value indicating whether we should initialize response
-headers from the E<lt>head> section of HTML documents. The default is
-true. I<Do not turn this off> unless you know what you are doing.
-
-=head2 protocols_allowed
-
- my $aref = $ua->protocols_allowed; # get allowed protocols
- $ua->protocols_allowed( \@protocols ); # allow ONLY these
- $ua->protocols_allowed(undef); # delete the list
- $ua->protocols_allowed(['http',]); # ONLY allow http
-
-By default, an object has neither a C<protocols_allowed> list, nor a
-L<LWP::UserAgent/protocols_forbidden> list.
-
-This reads (or sets) this user agent's list of protocols that the
-request methods will exclusively allow. The protocol names are case
-insensitive.
-
-For example: C<< $ua->protocols_allowed( [ 'http', 'https'] ); >>
-means that this user agent will I<allow only> those protocols,
-and attempts to use this user agent to access URLs with any other
-schemes (like C<ftp://...>) will result in a 500 error.
-
-Note that having a C<protocols_allowed> list causes any
-L<LWP::UserAgent/protocols_forbidden> list to be ignored.
-
-=head2 protocols_forbidden
-
- my $aref = $ua->protocols_forbidden; # get the forbidden list
- $ua->protocols_forbidden(\@protocols); # do not allow these
- $ua->protocols_forbidden(['http',]); # All http reqs get a 500
- $ua->protocols_forbidden(undef); # delete the list
-
-This reads (or sets) this user agent's list of protocols that the
-request method will I<not> allow. The protocol names are case
-insensitive.
-
-For example: C<< $ua->protocols_forbidden( [ 'file', 'mailto'] ); >>
-means that this user agent will I<not> allow those protocols, and
-attempts to use this user agent to access URLs with those schemes
-will result in a 500 error.
-
-=head2 requests_redirectable
-
- my $aref = $ua->requests_redirectable;
- $ua->requests_redirectable( \@requests );
- $ua->requests_redirectable(['GET', 'HEAD',]); # the default
-
-This reads or sets the object's list of request names that
-L<LWP::UserAgent/redirect_ok> will allow redirection for. By default, this
-is C<['GET', 'HEAD']>, as per L<RFC 2616|https://tools.ietf.org/html/rfc2616>.
-To change to include C<POST>, consider:
-
- push @{ $ua->requests_redirectable }, 'POST';
-
-=head2 send_te
-
- my $bool = $ua->send_te;
- $ua->send_te( $boolean );
-
-If true, will send a C<TE> header along with the request. The default is
-true. Set it to false to disable the C<TE> header for systems who can't
-handle it.
-
-=head2 show_progress
-
- my $bool = $ua->show_progress;
- $ua->show_progress( $boolean );
-
-Get/set a value indicating whether a progress bar should be displayed
-on the terminal as requests are processed. The default is false.
-
-=head2 ssl_opts
-
- my @keys = $ua->ssl_opts;
- my $val = $ua->ssl_opts( $key );
- $ua->ssl_opts( $key => $value );
-
-Get/set the options for SSL connections. Without argument return the list
-of options keys currently set. With a single argument return the current
-value for the given option. With 2 arguments set the option value and return
-the old. Setting an option to the value C<undef> removes this option.
-
-The options that LWP relates to are:
-
-=over
-
-=item C<verify_hostname> => $bool
-
-When TRUE LWP will for secure protocol schemes ensure it connects to servers
-that have a valid certificate matching the expected hostname. If FALSE no
-checks are made and you can't be sure that you communicate with the expected peer.
-The no checks behaviour was the default for libwww-perl-5.837 and earlier releases.
-
-This option is initialized from the C<PERL_LWP_SSL_VERIFY_HOSTNAME> environment
-variable. If this environment variable isn't set; then C<verify_hostname>
-defaults to 1.
-
-=item C<SSL_ca_file> => $path
-
-The path to a file containing Certificate Authority certificates.
-A default setting for this option is provided by checking the environment
-variables C<PERL_LWP_SSL_CA_FILE> and C<HTTPS_CA_FILE> in order.
-
-=item C<SSL_ca_path> => $path
-
-The path to a directory containing files containing Certificate Authority
-certificates.
-A default setting for this option is provided by checking the environment
-variables C<PERL_LWP_SSL_CA_PATH> and C<HTTPS_CA_DIR> in order.
-
-=back
-
-Other options can be set and are processed directly by the SSL Socket implementation
-in use. See L<IO::Socket::SSL> or L<Net::SSL> for details.
-
-The libwww-perl core no longer bundles protocol plugins for SSL. You will need
-to install L<LWP::Protocol::https> separately to enable support for processing
-https-URLs.
-
-=head2 timeout
-
- my $secs = $ua->timeout;
- $ua->timeout( $secs );
-
-Get/set the timeout value in seconds. The default value is
-180 seconds, i.e. 3 minutes.
-
-The request is aborted if no activity on the connection to the server
-is observed for C<timeout> seconds. This means that the time it takes
-for the complete transaction and the L<LWP::UserAgent/request> method to
-actually return might be longer.
-
-When a request times out, a response object is still returned. The response
-will have a standard HTTP Status Code (500). This response will have the
-"Client-Warning" header set to the value of "Internal response". See the
-L<LWP::UserAgent/get> method description below for further details.
-
-=head1 PROXY ATTRIBUTES
-
-The following methods set up when requests should be passed via a
-proxy server.
-
-=head2 env_proxy
-
- $ua->env_proxy;
-
-Load proxy settings from C<*_proxy> environment variables. You might
-specify proxies like this (sh-syntax):
-
- gopher_proxy=http://proxy.my.place/
- wais_proxy=http://proxy.my.place/
- no_proxy="localhost,example.com"
- export gopher_proxy wais_proxy no_proxy
-
-csh or tcsh users should use the C<setenv> command to define these
-environment variables.
-
-On systems with case insensitive environment variables there exists a
-name clash between the CGI environment variables and the C<HTTP_PROXY>
-environment variable normally picked up by C<env_proxy>. Because of
-this C<HTTP_PROXY> is not honored for CGI scripts. The
-C<CGI_HTTP_PROXY> environment variable can be used instead.
-
-=head2 no_proxy
-
- $ua->no_proxy( @domains );
- $ua->no_proxy('localhost', 'example.com');
- $ua->no_proxy(); # clear the list
-
-Do not proxy requests to the given domains. Calling C<no_proxy> without
-any domains clears the list of domains.
-
-=head2 proxy
-
- $ua->proxy(\@schemes, $proxy_url)
- $ua->proxy(['http', 'ftp'], 'http://proxy.sn.no:8001/');
-
- # For a single scheme:
- $ua->proxy($scheme, $proxy_url)
- $ua->proxy('gopher', 'http://proxy.sn.no:8001/');
-
- # To set multiple proxies at once:
- $ua->proxy([
- ftp => 'http://ftp.example.com:8001/',
- [ 'http', 'https' ] => 'http://http.example.com:8001/',
- ]);
-
-Set/retrieve proxy URL for a scheme.
-
-The first form specifies that the URL is to be used as a proxy for
-access methods listed in the list in the first method argument,
-i.e. C<http> and C<ftp>.
-
-The second form shows a shorthand form for specifying
-proxy URL for a single access scheme.
-
-The third form demonstrates setting multiple proxies at once. This is also
-the only form accepted by the constructor.
-
-=head1 HANDLERS
-
-Handlers are code that injected at various phases during the
-processing of requests. The following methods are provided to manage
-the active handlers:
-
-=head2 add_handler
-
- $ua->add_handler( $phase => \&cb, %matchspec )
-
-Add handler to be invoked in the given processing phase. For how to
-specify C<%matchspec> see L<HTTP::Config/"Matching">.
-
-The possible values C<$phase> and the corresponding callback signatures are as
-follows. Note that the handlers are documented in the order in which they will
-be run, which is:
-
- request_preprepare
- request_prepare
- request_send
- response_header
- response_data
- response_done
- response_redirect
-
-=over
-
-=item request_preprepare => sub { my($request, $ua, $handler) = @_; ... }
-
-The handler is called before the C<request_prepare> and other standard
-initialization of the request. This can be used to set up headers
-and attributes that the C<request_prepare> handler depends on. Proxy
-initialization should take place here; but in general don't register
-handlers for this phase.
-
-=item request_prepare => sub { my($request, $ua, $handler) = @_; ... }
-
-The handler is called before the request is sent and can modify the
-request any way it see fit. This can for instance be used to add
-certain headers to specific requests.
-
-The method can assign a new request object to C<$_[0]> to replace the
-request that is sent fully.
-
-The return value from the callback is ignored. If an exception is
-raised it will abort the request and make the request method return a
-"400 Bad request" response.
-
-=item request_send => sub { my($request, $ua, $handler) = @_; ... }
-
-This handler gets a chance of handling requests before they're sent to the
-protocol handlers. It should return an L<HTTP::Response> object if it
-wishes to terminate the processing; otherwise it should return nothing.
-
-The C<response_header> and C<response_data> handlers will not be
-invoked for this response, but the C<response_done> will be.
-
-=item response_header => sub { my($response, $ua, $handler) = @_; ... }
-
-This handler is called right after the response headers have been
-received, but before any content data. The handler might set up
-handlers for data and might croak to abort the request.
-
-The handler might set the C<< $response->{default_add_content} >> value to
-control if any received data should be added to the response object
-directly. This will initially be false if the C<< $ua->request() >> method
-was called with a C<$content_file> or C<$content_cb argument>; otherwise true.
-
-=item response_data => sub { my($response, $ua, $handler, $data) = @_; ... }
-
-This handler is called for each chunk of data received for the
-response. The handler might croak to abort the request.
-
-This handler needs to return a TRUE value to be called again for
-subsequent chunks for the same request.
-
-=item response_done => sub { my($response, $ua, $handler) = @_; ... }
-
-The handler is called after the response has been fully received, but
-before any redirect handling is attempted. The handler can be used to
-extract information or modify the response.
-
-=item response_redirect => sub { my($response, $ua, $handler) = @_; ... }
-
-The handler is called in C<< $ua->request >> after C<response_done>. If the
-handler returns an L<HTTP::Request> object we'll start over with processing
-this request instead.
-
-=back
-
-For all of these, C<$handler> is a code reference to the handler that
-is currently being run.
-
-=head2 get_my_handler
-
- $ua->get_my_handler( $phase, %matchspec );
- $ua->get_my_handler( $phase, %matchspec, $init );
-
-Will retrieve the matching handler as hash ref.
-
-If C<$init> is passed as a true value, create and add the
-handler if it's not found. If C<$init> is a subroutine reference, then
-it's called with the created handler hash as argument. This sub might
-populate the hash with extra fields; especially the callback. If
-C<$init> is a hash reference, merge the hashes.
-
-=head2 handlers
-
- $ua->handlers( $phase, $request )
- $ua->handlers( $phase, $response )
-
-Returns the handlers that apply to the given request or response at
-the given processing phase.
-
-=head2 remove_handler
-
- $ua->remove_handler( undef, %matchspec );
- $ua->remove_handler( $phase, %matchspec );
- $ua->remove_handler(); # REMOVE ALL HANDLERS IN ALL PHASES
-
-Remove handlers that match the given C<%matchspec>. If C<$phase> is not
-provided, remove handlers from all phases.
-
-Be careful as calling this function with C<%matchspec> that is not
-specific enough can remove handlers not owned by you. It's probably
-better to use the L<LWP::UserAgent/set_my_handler> method instead.
-
-The removed handlers are returned.
-
-=head2 set_my_handler
-
- $ua->set_my_handler( $phase, $cb, %matchspec );
- $ua->set_my_handler($phase, undef); # remove handler for phase
-
-Set handlers private to the executing subroutine. Works by defaulting
-an C<owner> field to the C<%matchspec> that holds the name of the called
-subroutine. You might pass an explicit C<owner> to override this.
-
-If C<$cb> is passed as C<undef>, remove the handler.
-
-=head1 REQUEST METHODS
-
-The methods described in this section are used to dispatch requests
-via the user agent. The following request methods are provided:
-
-=head2 delete
-
- my $res = $ua->delete( $url );
- my $res = $ua->delete( $url, $field_name => $value, ... );
-
-This method will dispatch a C<DELETE> request on the given URL. Additional
-headers and content options are the same as for the L<LWP::UserAgent/get>
-method.
-
-This method will use the C<DELETE()> function from L<HTTP::Request::Common>
-to build the request. See L<HTTP::Request::Common> for a details on
-how to pass form content and other advanced features.
-
-=head2 get
-
- my $res = $ua->get( $url );
- my $res = $ua->get( $url , $field_name => $value, ... );
-
-This method will dispatch a C<GET> request on the given URL. Further
-arguments can be given to initialize the headers of the request. These
-are given as separate name/value pairs. The return value is a
-response object. See L<HTTP::Response> for a description of the
-interface it provides.
-
-There will still be a response object returned when LWP can't connect to the
-server specified in the URL or when other failures in protocol handlers occur.
-These internal responses use the standard HTTP status codes, so the responses
-can't be differentiated by testing the response status code alone. Error
-responses that LWP generates internally will have the "Client-Warning" header
-set to the value "Internal response". If you need to differentiate these
-internal responses from responses that a remote server actually generates, you
-need to test this header value.
-
-Fields names that start with ":" are special. These will not
-initialize headers of the request but will determine how the response
-content is treated. The following special field names are recognized:
-
- ':content_file' => $filename
- ':content_cb' => \&callback
- ':read_size_hint' => $bytes
-
-If a C<$filename> is provided with the C<:content_file> option, then the
-response content will be saved here instead of in the response
-object. If a callback is provided with the C<:content_cb> option then
-this function will be called for each chunk of the response content as
-it is received from the server. If neither of these options are
-given, then the response content will accumulate in the response
-object itself. This might not be suitable for very large response
-bodies. Only one of C<:content_file> or C<:content_cb> can be
-specified. The content of unsuccessful responses will always
-accumulate in the response object itself, regardless of the
-C<:content_file> or C<:content_cb> options passed in. Note that errors
-writing to the content file (for example due to permission denied
-or the filesystem being full) will be reported via the C<Client-Aborted>
-or C<X-Died> response headers, and not the C<is_success> method.
-
-The C<:read_size_hint> option is passed to the protocol module which
-will try to read data from the server in chunks of this size. A
-smaller value for the C<:read_size_hint> will result in a higher
-number of callback invocations.
-
-The callback function is called with 3 arguments: a chunk of data, a
-reference to the response object, and a reference to the protocol
-object. The callback can abort the request by invoking C<die()>. The
-exception message will show up as the "X-Died" header field in the
-response returned by the C<< $ua->get() >> method.
-
-=head2 head
-
- my $res = $ua->head( $url );
- my $res = $ua->head( $url , $field_name => $value, ... );
-
-This method will dispatch a C<HEAD> request on the given URL.
-Otherwise it works like the L<LWP::UserAgent/get> method described above.
-
-=head2 is_protocol_supported
-
- my $bool = $ua->is_protocol_supported( $scheme );
-
-You can use this method to test whether this user agent object supports the
-specified C<scheme>. (The C<scheme> might be a string (like C<http> or
-C<ftp>) or it might be an L<URI> object reference.)
-
-Whether a scheme is supported is determined by the user agent's
-C<protocols_allowed> or C<protocols_forbidden> lists (if any), and by
-the capabilities of LWP. I.e., this will return true only if LWP
-supports this protocol I<and> it's permitted for this particular
-object.
-
-=head2 is_online
-
- my $bool = $ua->is_online;
-
-Tries to determine if you have access to the Internet. Returns C<1> (true)
-if the built-in heuristics determine that the user agent is
-able to access the Internet (over HTTP) or C<0> (false).
-
-See also L<LWP::Online>.
-
-=head2 mirror
-
- my $res = $ua->mirror( $url, $filename );
-
-This method will get the document identified by URL and store it in
-file called C<$filename>. If the file already exists, then the request
-will contain an C<If-Modified-Since> header matching the modification
-time of the file. If the document on the server has not changed since
-this time, then nothing happens. If the document has been updated, it
-will be downloaded again. The modification time of the file will be
-forced to match that of the server.
-
-Uses L<File::Copy/move> to attempt to atomically replace the C<$filename>.
-
-The return value is an L<HTTP::Response> object.
-
-=head2 patch
-
- # Any version of HTTP::Message works with this form:
- my $res = $ua->patch( $url, $field_name => $value, Content => $content );
-
- # Using hash or array references requires HTTP::Message >= 6.12
- use HTTP::Request 6.12;
- my $res = $ua->patch( $url, \%form );
- my $res = $ua->patch( $url, \@form );
- my $res = $ua->patch( $url, \%form, $field_name => $value, ... );
- my $res = $ua->patch( $url, $field_name => $value, Content => \%form );
- my $res = $ua->patch( $url, $field_name => $value, Content => \@form );
-
-This method will dispatch a C<PATCH> request on the given URL, with
-C<%form> or C<@form> providing the key/value pairs for the fill-in form
-content. Additional headers and content options are the same as for
-the L<LWP::UserAgent/get> method.
-
-CAVEAT:
-
-This method can only accept content that is in key-value pairs when using
-L<HTTP::Request::Common> prior to version C<6.12>. Any use of hash or array
-references will result in an error prior to version C<6.12>.
-
-This method will use the C<PATCH> function from L<HTTP::Request::Common>
-to build the request. See L<HTTP::Request::Common> for a details on
-how to pass form content and other advanced features.
-
-=head2 post
-
- my $res = $ua->post( $url, \%form );
- my $res = $ua->post( $url, \@form );
- my $res = $ua->post( $url, \%form, $field_name => $value, ... );
- my $res = $ua->post( $url, $field_name => $value, Content => \%form );
- my $res = $ua->post( $url, $field_name => $value, Content => \@form );
- my $res = $ua->post( $url, $field_name => $value, Content => $content );
-
-This method will dispatch a C<POST> request on the given URL, with
-C<%form> or C<@form> providing the key/value pairs for the fill-in form
-content. Additional headers and content options are the same as for
-the L<LWP::UserAgent/get> method.
-
-This method will use the C<POST> function from L<HTTP::Request::Common>
-to build the request. See L<HTTP::Request::Common> for a details on
-how to pass form content and other advanced features.
-
-=head2 put
-
- # Any version of HTTP::Message works with this form:
- my $res = $ua->put( $url, $field_name => $value, Content => $content );
-
- # Using hash or array references requires HTTP::Message >= 6.07
- use HTTP::Request 6.07;
- my $res = $ua->put( $url, \%form );
- my $res = $ua->put( $url, \@form );
- my $res = $ua->put( $url, \%form, $field_name => $value, ... );
- my $res = $ua->put( $url, $field_name => $value, Content => \%form );
- my $res = $ua->put( $url, $field_name => $value, Content => \@form );
-
-This method will dispatch a C<PUT> request on the given URL, with
-C<%form> or C<@form> providing the key/value pairs for the fill-in form
-content. Additional headers and content options are the same as for
-the L<LWP::UserAgent/get> method.
-
-CAVEAT:
-
-This method can only accept content that is in key-value pairs when using
-L<HTTP::Request::Common> prior to version C<6.07>. Any use of hash or array
-references will result in an error prior to version C<6.07>.
-
-This method will use the C<PUT> function from L<HTTP::Request::Common>
-to build the request. See L<HTTP::Request::Common> for a details on
-how to pass form content and other advanced features.
-
-=head2 request
-
- my $res = $ua->request( $request );
- my $res = $ua->request( $request, $content_file );
- my $res = $ua->request( $request, $content_cb );
- my $res = $ua->request( $request, $content_cb, $read_size_hint );
-
-This method will dispatch the given C<$request> object. Normally this
-will be an instance of the L<HTTP::Request> class, but any object with
-a similar interface will do. The return value is an L<HTTP::Response> object.
-
-The C<request> method will process redirects and authentication
-responses transparently. This means that it may actually send several
-simple requests via the L<LWP::UserAgent/simple_request> method described below.
-
-The request methods described above; L<LWP::UserAgent/get>, L<LWP::UserAgent/head>,
-L<LWP::UserAgent/post> and L<LWP::UserAgent/mirror> will all dispatch the request
-they build via this method. They are convenience methods that simply hide the
-creation of the request object for you.
-
-The C<$content_file>, C<$content_cb> and C<$read_size_hint> all correspond to
-options described with the L<LWP::UserAgent/get> method above. Note that errors
-writing to the content file (for example due to permission denied
-or the filesystem being full) will be reported via the C<Client-Aborted>
-or C<X-Died> response headers, and not the C<is_success> method.
-
-You are allowed to use a CODE reference as C<content> in the request
-object passed in. The C<content> function should return the content
-when called. The content can be returned in chunks. The content
-function will be invoked repeatedly until it return an empty string to
-signal that there is no more content.
-
-=head2 simple_request
-
- my $request = HTTP::Request->new( ... );
- my $res = $ua->simple_request( $request );
- my $res = $ua->simple_request( $request, $content_file );
- my $res = $ua->simple_request( $request, $content_cb );
- my $res = $ua->simple_request( $request, $content_cb, $read_size_hint );
-
-This method dispatches a single request and returns the response
-received. Arguments are the same as for the L<LWP::UserAgent/request> described above.
-
-The difference from L<LWP::UserAgent/request> is that C<simple_request> will not try to
-handle redirects or authentication responses. The L<LWP::UserAgent/request> method
-will, in fact, invoke this method for each simple request it sends.
-
-=head1 CALLBACK METHODS
-
-The following methods will be invoked as requests are processed. These
-methods are documented here because subclasses of L<LWP::UserAgent>
-might want to override their behaviour.
-
-=head2 get_basic_credentials
-
- # This checks wantarray and can either return an array:
- my ($user, $pass) = $ua->get_basic_credentials( $realm, $uri, $isproxy );
- # or a string that looks like "user:pass"
- my $creds = $ua->get_basic_credentials($realm, $uri, $isproxy);
-
-This is called by L<LWP::UserAgent/request> to retrieve credentials for documents
-protected by Basic or Digest Authentication. The arguments passed in
-is the C<$realm> provided by the server, the C<$uri> requested and a
-C<boolean flag> to indicate if this is authentication against a proxy server.
-
-The method should return a username and password. It should return an
-empty list to abort the authentication resolution attempt. Subclasses
-can override this method to prompt the user for the information. An
-example of this can be found in C<lwp-request> program distributed
-with this library.
-
-The base implementation simply checks a set of pre-stored member
-variables, set up with the L<LWP::UserAgent/credentials> method.
-
-=head2 prepare_request
-
- $request = $ua->prepare_request( $request );
-
-This method is invoked by L<LWP::UserAgent/simple_request>. Its task is
-to modify the given C<$request> object by setting up various headers based
-on the attributes of the user agent. The return value should normally be the
-C<$request> object passed in. If a different request object is returned
-it will be the one actually processed.
-
-The headers affected by the base implementation are; C<User-Agent>,
-C<From>, C<Range> and C<Cookie>.
-
-=head2 progress
-
- my $prog = $ua->progress( $status, $request_or_response );
-
-This is called frequently as the response is received regardless of
-how the content is processed. The method is called with C<$status>
-"begin" at the start of processing the request and with C<$state> "end"
-before the request method returns. In between these C<$status> will be
-the fraction of the response currently received or the string "tick"
-if the fraction can't be calculated.
-
-When C<$status> is "begin" the second argument is the L<HTTP::Request> object,
-otherwise it is the L<HTTP::Response> object.
-
-=head2 redirect_ok
-
- my $bool = $ua->redirect_ok( $prospective_request, $response );
-
-This method is called by L<LWP::UserAgent/request> before it tries to follow a
-redirection to the request in C<$response>. This should return a true
-value if this redirection is permissible. The C<$prospective_request>
-will be the request to be sent if this method returns true.
-
-The base implementation will return false unless the method
-is in the object's C<requests_redirectable> list,
-false if the proposed redirection is to a C<file://...>
-URL, and true otherwise.
-
-=head1 BEST PRACTICES
-
-The default settings can get you up and running quickly, but there are settings
-you can change in order to make your life easier.
-
-=head2 Handling Cookies
-
-You are encouraged to install L<Mozilla::PublicSuffix> and use
-L<HTTP::CookieJar::LWP> as your cookie jar. L<HTTP::CookieJar::LWP> provides a
-better security model matching that of current Web browsers when
-L<Mozilla::PublicSuffix> is installed.
-
- use HTTP::CookieJar::LWP ();
-
- my $jar = HTTP::CookieJar::LWP->new;
- my $ua = LWP::UserAgent->new( cookie_jar => $jar );
-
-See L</"cookie_jar"> for more information.
-
-=head2 Managing Protocols
-
-C<protocols_allowed> gives you the ability to allow arbitrary protocols.
-
- my $ua = LWP::UserAgent->new(
- protocols_allowed => [ 'http', 'https' ]
- );
-
-This will prevent you from inadvertently following URLs like
-C<file:///etc/passwd>. See L</"protocols_allowed">.
-
-C<protocols_forbidden> gives you the ability to deny arbitrary protocols.
-
- my $ua = LWP::UserAgent->new(
- protocols_forbidden => [ 'file', 'mailto', 'ssh', ]
- );
-
-This can also prevent you from inadvertently following URLs like
-C<file:///etc/passwd>. See L</protocols_forbidden>.
-
-=head1 SEE ALSO
-
-See L<LWP> for a complete overview of libwww-perl5. See L<lwpcook>
-and the scripts F<lwp-request> and F<lwp-download> for examples of
-usage.
-
-See L<HTTP::Request> and L<HTTP::Response> for a description of the
-message objects dispatched and received. See L<HTTP::Request::Common>
-and L<HTML::Form> for other ways to build request objects.
-
-See L<WWW::Mechanize> and L<WWW::Search> for examples of more
-specialized user agents based on L<LWP::UserAgent>.
-
-=head1 COPYRIGHT AND LICENSE
-
-Copyright 1995-2009 Gisle Aas.
-
-This library is free software; you can redistribute it and/or
-modify it under the same terms as Perl itself.
-
-=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm
index 5cb6f5a45c..59b968af89 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm
@@ -4,7 +4,8 @@ use strict;
use warnings;
BEGIN {
-our $VERSION = '0.54';
+our $VERSION = '0.57';
+
require XSLoader;
XSLoader::load('Math::Int64', $VERSION);
}
@@ -20,6 +21,7 @@ our @ISA = qw(Exporter);
our @EXPORT_OK = qw(int64
int64_to_number
net_to_int64 int64_to_net
+ le_to_int64 int64_to_le
native_to_int64 int64_to_native
string_to_int64 hex_to_int64
BER_to_int64 int64_to_BER
@@ -29,6 +31,7 @@ our @EXPORT_OK = qw(int64
uint64
uint64_to_number
net_to_uint64 uint64_to_net
+ le_to_uint64 uint64_to_le
native_to_uint64 uint64_to_native
string_to_uint64 hex_to_uint64
BER_to_uint64 uint64_to_BER
@@ -209,13 +212,20 @@ internal representation used by this module.
=item int64_to_net($int64)
Returns an 8 bytes string with the representation of the int64 value
-in network order.
+in network order (big endian).
=item native_to_int64($str)
=item int64_to_native($int64)
-similar to net_to_int64 and int64_to_net, but using the native CPU
+Similar to net_to_int64 and int64_to_net, but using the native CPU
+order.
+
+=item le_to_int64($str)
+
+=item int64_to_le($int64)
+
+Similar to net_to_int64 and int64_to_net, but using the little endian
order.
=item int64_to_number($int64)
@@ -324,6 +334,10 @@ C<$seed>, if given, should be a 2KB long string.
=item uint64_to_native
+=item le_to_uint64
+
+=item uint64_to_le
+
=item string_to_uint64
=item hex_to_uint64
@@ -577,7 +591,7 @@ L<Math::BigInt::GMP>.
=head1 COPYRIGHT AND LICENSE
-Copyright E<copy> 2007, 2009, 2011-2015 by Salvador Fandiño
+Copyright E<copy> 2007, 2009, 2011-2015, 2024 by Salvador Fandiño
(sfandino@yahoo.com)
Copyright E<copy> 2014-2015 by Dave Rolsky (autarch@urth.org)
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Module/Build/Tiny.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Module/Build/Tiny.pm
new file mode 100755
index 0000000000..752c784622
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Module/Build/Tiny.pm
@@ -0,0 +1,349 @@
+package Module::Build::Tiny;
+$Module::Build::Tiny::VERSION = '0.047';
+use strict;
+use warnings;
+use Exporter 5.57 'import';
+our @EXPORT = qw/Build Build_PL/;
+
+use CPAN::Meta;
+use ExtUtils::Config 0.003;
+use ExtUtils::Helpers 0.020 qw/make_executable split_like_shell man1_pagename man3_pagename detildefy/;
+use ExtUtils::Install qw/pm_to_blib install/;
+use ExtUtils::InstallPaths 0.002;
+use File::Basename qw/basename dirname/;
+use File::Find ();
+use File::Path qw/mkpath rmtree/;
+use File::Spec::Functions qw/catfile catdir rel2abs abs2rel splitdir curdir/;
+use Getopt::Long 2.36 qw/GetOptionsFromArray/;
+use JSON::PP 2 qw/encode_json decode_json/;
+
+sub write_file {
+ my ($filename, $content) = @_;
+ open my $fh, '>', $filename or die "Could not open $filename: $!\n";
+ print $fh $content;
+}
+sub read_file {
+ my ($filename) = @_;
+ open my $fh, '<', $filename or die "Could not open $filename: $!\n";
+ return do { local $/; <$fh> };
+}
+
+sub get_meta {
+ my ($metafile) = grep { -e $_ } qw/META.json META.yml/ or die "No META information provided\n";
+ return CPAN::Meta->load_file($metafile);
+}
+
+sub manify {
+ my ($input_file, $output_file, $section, $opts) = @_;
+ return if -e $output_file && -M $input_file <= -M $output_file;
+ my $dirname = dirname($output_file);
+ mkpath($dirname, $opts->{verbose}) if not -d $dirname;
+ require Pod::Man;
+ Pod::Man->new(section => $section)->parse_from_file($input_file, $output_file);
+ print "Manifying $output_file\n" if $opts->{verbose} && $opts->{verbose} > 0;
+ return;
+}
+
+sub process_xs {
+ my ($source, $options, $c_files) = @_;
+
+ die "Can't build xs files under --pureperl-only\n" if $options->{'pureperl-only'};
+ my (undef, @parts) = splitdir(dirname($source));
+ push @parts, my $file_base = basename($source, '.xs');
+ my $archdir = catdir(qw/blib arch auto/, @parts);
+ my $tempdir = 'temp';
+
+ my $c_file = catfile($tempdir, "$file_base.c");
+ require ExtUtils::ParseXS;
+ mkpath($tempdir, $options->{verbose}, oct '755');
+ ExtUtils::ParseXS::process_file(filename => $source, prototypes => 0, output => $c_file);
+
+ my $version = $options->{meta}->version;
+ require ExtUtils::CBuilder;
+ my $builder = ExtUtils::CBuilder->new(config => $options->{config}->values_set);
+ my @objects = $builder->compile(source => $c_file, defines => { VERSION => qq/"$version"/, XS_VERSION => qq/"$version"/ }, include_dirs => [ curdir, 'include', 'src', dirname($source) ]);
+
+ my $o = $options->{config}->get('_o');
+ for my $c_source (@{ $c_files }) {
+ my $o_file = catfile($tempdir, basename($c_source, '.c') . $o);
+ push @objects, $builder->compile(source => $c_source, include_dirs => [ curdir, 'include', 'src', dirname($c_source) ])
+ }
+
+ require DynaLoader;
+ my $mod2fname = defined &DynaLoader::mod2fname ? \&DynaLoader::mod2fname : sub { return $_[0][-1] };
+
+ mkpath($archdir, $options->{verbose}, oct '755') unless -d $archdir;
+ my $lib_file = catfile($archdir, $mod2fname->(\@parts) . '.' . $options->{config}->get('dlext'));
+ return $builder->link(objects => \@objects, lib_file => $lib_file, module_name => join '::', @parts);
+}
+
+sub find {
+ my ($pattern, $dir) = @_;
+ my @ret;
+ File::Find::find(sub { push @ret, $File::Find::name if /$pattern/ && -f }, $dir) if -d $dir;
+ return @ret;
+}
+
+sub contains_pod {
+ my ($file) = @_;
+ return unless -T $file;
+ return read_file($file) =~ /^\=(?:head|pod|item)/m;
+}
+
+my %actions = (
+ build => sub {
+ my %opt = @_;
+ for my $pl_file (find(qr/\.PL$/, 'lib')) {
+ (my $pm = $pl_file) =~ s/\.PL$//;
+ system $^X, $pl_file, $pm and die "$pl_file returned $?\n";
+ }
+ my %modules = map { $_ => catfile('blib', $_) } find(qr/\.pm$/, 'lib');
+ my %docs = map { $_ => catfile('blib', $_) } find(qr/\.pod$/, 'lib');
+ my %scripts = map { $_ => catfile('blib', $_) } find(qr/(?:)/, 'script');
+ my %sdocs = map { $_ => delete $scripts{$_} } grep { /.pod$/ } keys %scripts;
+ my %dist_shared = map { $_ => catfile(qw/blib lib auto share dist/, $opt{meta}->name, abs2rel($_, 'share')) } find(qr/(?:)/, 'share');
+ my %module_shared = map { $_ => catfile(qw/blib lib auto share module/, abs2rel($_, 'module-share')) } find(qr/(?:)/, 'module-share');
+ pm_to_blib({ %modules, %docs, %scripts, %dist_shared, %module_shared }, catdir(qw/blib lib auto/));
+ make_executable($_) for values %scripts;
+ mkpath(catdir(qw/blib arch/), $opt{verbose});
+ my $main_xs = join('/', 'lib', split /-/, $opt{meta}->name) . '.xs';
+ for my $xs (find(qr/.xs$/, 'lib')) {
+ my @c_files = $xs eq $main_xs ? find(qr/\.c$/, 'src') : ();
+ process_xs($xs, \%opt, \@c_files);
+ }
+
+ if ($opt{install_paths}->install_destination('bindoc') && $opt{install_paths}->is_default_installable('bindoc')) {
+ my $section = $opt{config}->get('man1ext');
+ for my $input (keys %scripts, keys %sdocs) {
+ next unless contains_pod($input);
+ my $output = catfile('blib', 'bindoc', man1_pagename($input));
+ manify($input, $output, $section, \%opt);
+ }
+ }
+ if ($opt{install_paths}->install_destination('libdoc') && $opt{install_paths}->is_default_installable('libdoc')) {
+ my $section = $opt{config}->get('man3ext');
+ for my $input (keys %modules, keys %docs) {
+ next unless contains_pod($input);
+ my $output = catfile('blib', 'libdoc', man3_pagename($input));
+ manify($input, $output, $section, \%opt);
+ }
+ }
+ return 0;
+ },
+ test => sub {
+ my %opt = @_;
+ die "Must run `./Build build` first\n" if not -d 'blib';
+ require TAP::Harness::Env;
+ my %test_args = (
+ (verbosity => $opt{verbose}) x!! exists $opt{verbose},
+ (jobs => $opt{jobs}) x!! exists $opt{jobs},
+ (color => 1) x !!-t STDOUT,
+ lib => [ map { rel2abs(catdir(qw/blib/, $_)) } qw/arch lib/ ],
+ );
+ my $tester = TAP::Harness::Env->create(\%test_args);
+ return $tester->runtests(sort +find(qr/\.t$/, 't'))->has_errors;
+ },
+ install => sub {
+ my %opt = @_;
+ die "Must run `./Build build` first\n" if not -d 'blib';
+ install($opt{install_paths}->install_map, @opt{qw/verbose dry_run uninst/});
+ return 0;
+ },
+ clean => sub {
+ my %opt = @_;
+ rmtree($_, $opt{verbose}) for qw/blib temp/;
+ return 0;
+ },
+ realclean => sub {
+ my %opt = @_;
+ rmtree($_, $opt{verbose}) for qw/blib temp Build _build_params MYMETA.yml MYMETA.json/;
+ return 0;
+ },
+);
+
+sub Build {
+ my $action = @ARGV && $ARGV[0] =~ /\A\w+\z/ ? shift @ARGV : 'build';
+ die "No such action '$action'\n" if not $actions{$action};
+ my($env, $bargv) = @{ decode_json(read_file('_build_params')) };
+ my %opt;
+ GetOptionsFromArray($_, \%opt, qw/install_base=s install_path=s% installdirs=s destdir=s prefix=s config=s% uninst:1 verbose:1 dry_run:1 pureperl-only:1 create_packlist=i jobs=i/) for ($env, $bargv, \@ARGV);
+ $_ = detildefy($_) for grep { defined } @opt{qw/install_base destdir prefix/}, values %{ $opt{install_path} };
+ @opt{ 'config', 'meta' } = (ExtUtils::Config->new($opt{config}), get_meta());
+ exit $actions{$action}->(%opt, install_paths => ExtUtils::InstallPaths->new(%opt, dist_name => $opt{meta}->name));
+}
+
+sub Build_PL {
+ my $meta = get_meta();
+ printf "Creating new 'Build' script for '%s' version '%s'\n", $meta->name, $meta->version;
+ my $dir = $meta->name eq 'Module-Build-Tiny' ? "use lib 'lib';" : '';
+ write_file('Build', "#!perl\n$dir\nuse Module::Build::Tiny;\nBuild();\n");
+ make_executable('Build');
+ my @env = defined $ENV{PERL_MB_OPT} ? split_like_shell($ENV{PERL_MB_OPT}) : ();
+ write_file('_build_params', encode_json([ \@env, \@ARGV ]));
+ $meta->save(@$_) for ['MYMETA.json'], [ 'MYMETA.yml' => { version => 1.4 } ];
+}
+
+1;
+
+#ABSTRACT: A tiny replacement for Module::Build
+
+
+# vi:noet:sts=4:sw=4:ts=4
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Module::Build::Tiny - A tiny replacement for Module::Build
+
+=head1 VERSION
+
+version 0.047
+
+=head1 SYNOPSIS
+
+ use Module::Build::Tiny;
+ Build_PL();
+
+=head1 DESCRIPTION
+
+Many Perl distributions use a Build.PL file instead of a Makefile.PL file
+to drive distribution configuration, build, test and installation.
+Traditionally, Build.PL uses Module::Build as the underlying build system.
+This module provides a simple, lightweight, drop-in replacement.
+
+Whereas Module::Build has over 6,700 lines of code; this module has less
+than 200, yet supports the features needed by most distributions.
+
+=head2 Supported
+
+=over 4
+
+=item * Pure Perl distributions
+
+=item * Building XS or C
+
+=item * Recursive test files
+
+=item * MYMETA
+
+=item * Man page generation
+
+=item * Generated code from PL files
+
+=item * Module sharedirs
+
+=back
+
+=head2 Not Supported
+
+=over 4
+
+=item * Dynamic prerequisites
+
+=item * HTML documentation generation
+
+=item * Extending Module::Build::Tiny
+
+=back
+
+=head2 Directory structure
+
+Your .pm, .xs and .pod files must be in F<lib/>. Any executables must be in
+F<script/>. Test files must be in F<t/>. Dist sharedirs must be in F<share/>,
+module sharedirs are under F<module-share> (e.g. F<module-share/Foo-Bar> for
+module C<Foo::Bar>).
+
+C<.c> files in the F<src/> are compiled together with the .xs file matching the
+distribution name.
+
+=head1 USAGE
+
+These all work pretty much like their Module::Build equivalents.
+
+=head2 perl Build.PL
+
+=head2 Build [ build ]
+
+=head2 Build test
+
+=head2 Build install
+
+This supports the following options:
+
+=over
+
+=item * verbose
+
+=item * install_base
+
+=item * installdirs
+
+=item * prefix
+
+=item * install_path
+
+=item * destdir
+
+=item * uninst
+
+=item * config
+
+=item * pure-perl
+
+=item * create_packlist
+
+=back
+
+=head1 AUTHORING
+
+This module doesn't support authoring. To develop modules using Module::Build::Tiny, usage of L<Dist::Zilla::Plugin::ModuleBuildTiny> or L<App::ModuleBuildTiny> is recommended.
+
+=head1 CONFIG FILE AND ENVIRONMENT
+
+Options can be provided in the C<PERL_MB_OPT> environment variable the same way they can with Module::Build. This should be done during the configuration stage.
+
+=head2 Incompatibilities
+
+=over 4
+
+=item * Argument parsing
+
+Module::Build has an extremely permissive way of argument handling, Module::Build::Tiny only supports a (sane) subset of that. In particular, C<./Build destdir=/foo> does not work, you will need to pass it as C<./Build --destdir=/foo>.
+
+=item * .modulebuildrc
+
+Module::Build::Tiny does not support .modulebuildrc files. In particular, this means that versions of local::lib older than 1.006008 may break with C<ERROR: Can't create /usr/local/somepath>. If the output of C<perl -Mlocal::lib> contains C<MODULEBUILDRC> but not C<PERL_MB_OPT >, you will need to upgrade it to resolve this issue.
+
+=back
+
+=head1 SEE ALSO
+
+L<Module::Build>
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Leon Timmermans <leont@cpan.org>
+
+=item *
+
+David Golden <dagolden@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2011 by Leon Timmermans, David Golden.
+
+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/Mozilla/CA.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA.pm
index dbbc6268c8..63bbc83321 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA.pm
@@ -1,18 +1,15 @@
package Mozilla::CA;
-
use strict;
-our $VERSION = '20211001';
+use warnings;
+
+our $VERSION = '20231213';
-use Cwd ();
use File::Spec ();
use File::Basename qw(dirname);
sub SSL_ca_file {
my $file = File::Spec->catfile(dirname(__FILE__), "CA", "cacert.pem");
- if (!File::Spec->file_name_is_absolute($file)) {
- $file = File::Spec->catfile(Cwd::cwd(), $file);
- }
- return $file;
+ return File::Spec->rel2abs($file);
}
1;
@@ -30,14 +27,14 @@ Mozilla::CA - Mozilla's CA cert bundle in PEM format
my $host = "www.paypal.com";
my $client = IO::Socket::SSL->new(
- PeerHost => "$host:443",
- SSL_verify_mode => 0x02,
- SSL_ca_file => Mozilla::CA::SSL_ca_file(),
+ PeerHost => "$host:443",
+ SSL_verify_mode => 0x02,
+ SSL_ca_file => Mozilla::CA::SSL_ca_file(),
)
- || die "Can't connect: $@";
+ || die "Can't connect: $@";
$client->verify_hostname($host, "http")
- || die "hostname verification failure";
+ || die "hostname verification failure";
=head1 DESCRIPTION
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA/cacert.pem b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA/cacert.pem
index dcaeb7359d..6a898bb7c6 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA/cacert.pem
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA/cacert.pem
@@ -1,7 +1,7 @@
##
## Bundle of CA Root Certificates
##
-## Certificate data from Mozilla as of: Fri Oct 1 13:46:52 2021 GMT
+## Certificate data from Mozilla as of: Wed Dec 13 16:41:47 2023 GMT
##
## This is a bundle of X.509 certificates of public Certificate Authorities
## (CA). These were automatically extracted from Mozilla's root certificates
@@ -13,8 +13,8 @@
## an Apache+mod_ssl webserver for SSL client authentication.
## Just configure this file as the SSLCACertificateFile.
##
-## Conversion done with mk-ca-bundle.pl version 1.28.
-## SHA256: c8f6733d1ff4e6a4769c182971a1234f95ae079247a9c439a13423fe8ba5c24f
+## Conversion done with mk-ca-bundle.pl version 1.29.
+## SHA256: 1970dd65858925d68498d2356aea6d03f764422523c5887deca8ce3ba9e1f845
##
@@ -39,28 +39,6 @@ hm4qxFYxldBniYUr+WymXUadDKqC5JlR3XC321Y9YeRq4VzW9v493kHMB65jUr9TU/Qr6cf9tveC
X4XSQRjbgbMEHMUfpIBvFSDJ3gyICh3WZlXi/EjJKSZp4A==
-----END CERTIFICATE-----
-GlobalSign Root CA - R2
-=======================
------BEGIN CERTIFICATE-----
-MIIDujCCAqKgAwIBAgILBAAAAAABD4Ym5g0wDQYJKoZIhvcNAQEFBQAwTDEgMB4GA1UECxMXR2xv
-YmFsU2lnbiBSb290IENBIC0gUjIxEzARBgNVBAoTCkdsb2JhbFNpZ24xEzARBgNVBAMTCkdsb2Jh
-bFNpZ24wHhcNMDYxMjE1MDgwMDAwWhcNMjExMjE1MDgwMDAwWjBMMSAwHgYDVQQLExdHbG9iYWxT
-aWduIFJvb3QgQ0EgLSBSMjETMBEGA1UEChMKR2xvYmFsU2lnbjETMBEGA1UEAxMKR2xvYmFsU2ln
-bjCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAKbPJA6+Lm8omUVCxKs+IVSbC9N/hHD6
-ErPLv4dfxn+G07IwXNb9rfF73OX4YJYJkhD10FPe+3t+c4isUoh7SqbKSaZeqKeMWhG8eoLrvozp
-s6yWJQeXSpkqBy+0Hne/ig+1AnwblrjFuTosvNYSuetZfeLQBoZfXklqtTleiDTsvHgMCJiEbKjN
-S7SgfQx5TfC4LcshytVsW33hoCmEofnTlEnLJGKRILzdC9XZzPnqJworc5HGnRusyMvo4KD0L5CL
-TfuwNhv2GXqF4G3yYROIXJ/gkwpRl4pazq+r1feqCapgvdzZX99yqWATXgAByUr6P6TqBwMhAo6C
-ygPCm48CAwEAAaOBnDCBmTAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4E
-FgQUm+IHV2ccHsBqBt5ZtJot39wZhi4wNgYDVR0fBC8wLTAroCmgJ4YlaHR0cDovL2NybC5nbG9i
-YWxzaWduLm5ldC9yb290LXIyLmNybDAfBgNVHSMEGDAWgBSb4gdXZxwewGoG3lm0mi3f3BmGLjAN
-BgkqhkiG9w0BAQUFAAOCAQEAmYFThxxol4aR7OBKuEQLq4GsJ0/WwbgcQ3izDJr86iw8bmEbTUsp
-9Z8FHSbBuOmDAGJFtqkIk7mpM0sYmsL4h4hO291xNBrBVNpGP+DTKqttVCL1OmLNIG+6KYnX3ZHu
-01yiPqFbQfXf5WRDLenVOavSot+3i9DAgBkcRcAtjOj4LaR0VknFBbVPFd5uRHg5h6h+u/N5GJG7
-9G+dwfCMNYxdAfvDbbnvRG15RjF+Cv6pgsH/76tuIMRQyV+dTZsXjAzlAcmgQWpzU/qlULRuJQ/7
-TBj0/VLZjmmx6BEP3ojY+x1J96relc8geMJgEtslQIxq/H5COEBkEveegeGTLg==
------END CERTIFICATE-----
-
Entrust.net Premium 2048 Secure Server CA
=========================================
-----BEGIN CERTIFICATE-----
@@ -222,27 +200,6 @@ vGJHvOB0K7Lrfb5BG7XARsWhIstfTsEokt4YutUqKLsRixeTmJlglFwjz1onl14LBQaTNx47aTbr
qZ5hHY8y2o4M1nQ+ewkk2gF3R8Q7zTSMmfXK4SVhM7JZG+Ju1zdXtg2pEto=
-----END CERTIFICATE-----
-Security Communication Root CA
-==============================
------BEGIN CERTIFICATE-----
-MIIDWjCCAkKgAwIBAgIBADANBgkqhkiG9w0BAQUFADBQMQswCQYDVQQGEwJKUDEYMBYGA1UEChMP
-U0VDT00gVHJ1c3QubmV0MScwJQYDVQQLEx5TZWN1cml0eSBDb21tdW5pY2F0aW9uIFJvb3RDQTEw
-HhcNMDMwOTMwMDQyMDQ5WhcNMjMwOTMwMDQyMDQ5WjBQMQswCQYDVQQGEwJKUDEYMBYGA1UEChMP
-U0VDT00gVHJ1c3QubmV0MScwJQYDVQQLEx5TZWN1cml0eSBDb21tdW5pY2F0aW9uIFJvb3RDQTEw
-ggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCzs/5/022x7xZ8V6UMbXaKL0u/ZPtM7orw
-8yl89f/uKuDp6bpbZCKamm8sOiZpUQWZJtzVHGpxxpp9Hp3dfGzGjGdnSj74cbAZJ6kJDKaVv0uM
-DPpVmDvY6CKhS3E4eayXkmmziX7qIWgGmBSWh9JhNrxtJ1aeV+7AwFb9Ms+k2Y7CI9eNqPPYJayX
-5HA49LY6tJ07lyZDo6G8SVlyTCMwhwFY9k6+HGhWZq/NQV3Is00qVUarH9oe4kA92819uZKAnDfd
-DJZkndwi92SL32HeFZRSFaB9UslLqCHJxrHty8OVYNEP8Ktw+N/LTX7s1vqr2b1/VPKl6Xn62dZ2
-JChzAgMBAAGjPzA9MB0GA1UdDgQWBBSgc0mZaNyFW2XjmygvV5+9M7wHSDALBgNVHQ8EBAMCAQYw
-DwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQUFAAOCAQEAaECpqLvkT115swW1F7NgE+vGkl3g
-0dNq/vu+m22/xwVtWSDEHPC32oRYAmP6SBbvT6UL90qY8j+eG61Ha2POCEfrUj94nK9NrvjVT8+a
-mCoQQTlSxN3Zmw7vkwGusi7KaEIkQmywszo+zenaSMQVy+n5Bw+SUEmK3TGXX8npN6o7WWWXlDLJ
-s58+OmJYxUmtYg5xpTKqL8aJdkNAExNnPaJUJRDL8Try2frbSVa7pv6nQTXD4IhhyYjH3zYQIphZ
-6rBK+1YWc26sTfcioU+tHXotRSflMMFe8toTyyVCUZVHA4xsIcx0Qu1T/zOLjw9XARYvz6buyXAi
-FL39vmwLAw==
------END CERTIFICATE-----
-
XRamp Global CA Root
====================
-----BEGIN CERTIFICATE-----
@@ -511,29 +468,6 @@ IGfE7vmLV2H0knZ9P4SNVbfo5azV8fUZVqZa+5Acr5Pr5RzUZ5ddBA6+C4OmF4O5MBKgxTMVBbkN
+8cFduPYSo38NBejxiEovjBFMR7HeL5YYTisO+IBZQ==
-----END CERTIFICATE-----
-Network Solutions Certificate Authority
-=======================================
------BEGIN CERTIFICATE-----
-MIID5jCCAs6gAwIBAgIQV8szb8JcFuZHFhfjkDFo4DANBgkqhkiG9w0BAQUFADBiMQswCQYDVQQG
-EwJVUzEhMB8GA1UEChMYTmV0d29yayBTb2x1dGlvbnMgTC5MLkMuMTAwLgYDVQQDEydOZXR3b3Jr
-IFNvbHV0aW9ucyBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkwHhcNMDYxMjAxMDAwMDAwWhcNMjkxMjMx
-MjM1OTU5WjBiMQswCQYDVQQGEwJVUzEhMB8GA1UEChMYTmV0d29yayBTb2x1dGlvbnMgTC5MLkMu
-MTAwLgYDVQQDEydOZXR3b3JrIFNvbHV0aW9ucyBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkwggEiMA0G
-CSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDkvH6SMG3G2I4rC7xGzuAnlt7e+foS0zwzc7MEL7xx
-jOWftiJgPl9dzgn/ggwbmlFQGiaJ3dVhXRncEg8tCqJDXRfQNJIg6nPPOCwGJgl6cvf6UDL4wpPT
-aaIjzkGxzOTVHzbRijr4jGPiFFlp7Q3Tf2vouAPlT2rlmGNpSAW+Lv8ztumXWWn4Zxmuk2GWRBXT
-crA/vGp97Eh/jcOrqnErU2lBUzS1sLnFBgrEsEX1QV1uiUV7PTsmjHTC5dLRfbIR1PtYMiKagMnc
-/Qzpf14Dl847ABSHJ3A4qY5usyd2mFHgBeMhqxrVhSI8KbWaFsWAqPS7azCPL0YCorEMIuDTAgMB
-AAGjgZcwgZQwHQYDVR0OBBYEFCEwyfsA106Y2oeqKtCnLrFAMadMMA4GA1UdDwEB/wQEAwIBBjAP
-BgNVHRMBAf8EBTADAQH/MFIGA1UdHwRLMEkwR6BFoEOGQWh0dHA6Ly9jcmwubmV0c29sc3NsLmNv
-bS9OZXR3b3JrU29sdXRpb25zQ2VydGlmaWNhdGVBdXRob3JpdHkuY3JsMA0GCSqGSIb3DQEBBQUA
-A4IBAQC7rkvnt1frf6ott3NHhWrB5KUd5Oc86fRZZXe1eltajSU24HqXLjjAV2CDmAaDn7l2em5Q
-4LqILPxFzBiwmZVRDuwduIj/h1AcgsLj4DKAv6ALR8jDMe+ZZzKATxcheQxpXN5eNK4CtSbqUN9/
-GGUsyfJj4akH/nxxH2szJGoeBfcFaMBqEssuXmHLrijTfsK0ZpEmXzwuJF/LWA/rKOyvEZbz3Htv
-wKeI8lN3s2Berq4o2jUsbzRF0ybh3uxbTydrFny9RAQYgrOJeRcQcT16ohZO9QHNpGxlaKFJdlxD
-ydi8NmdspZS11My5vWo1ViHe2MPr+8ukYEywVaCge1ey
------END CERTIFICATE-----
-
COMODO ECC Certification Authority
==================================
-----BEGIN CERTIFICATE-----
@@ -573,28 +507,6 @@ PBS1xp81HlDQwY9qcEQCYsuuHWhBp6pX6FOqB9IG9tUUBguRA3UsbHK1YZWaDYu5Def131TN3ubY
WyH8EZE0vkHve52Xdf+XlcCWWC/qu0bXu+TZLg==
-----END CERTIFICATE-----
-Cybertrust Global Root
-======================
------BEGIN CERTIFICATE-----
-MIIDoTCCAomgAwIBAgILBAAAAAABD4WqLUgwDQYJKoZIhvcNAQEFBQAwOzEYMBYGA1UEChMPQ3li
-ZXJ0cnVzdCwgSW5jMR8wHQYDVQQDExZDeWJlcnRydXN0IEdsb2JhbCBSb290MB4XDTA2MTIxNTA4
-MDAwMFoXDTIxMTIxNTA4MDAwMFowOzEYMBYGA1UEChMPQ3liZXJ0cnVzdCwgSW5jMR8wHQYDVQQD
-ExZDeWJlcnRydXN0IEdsb2JhbCBSb290MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA
-+Mi8vRRQZhP/8NN57CPytxrHjoXxEnOmGaoQ25yiZXRadz5RfVb23CO21O1fWLE3TdVJDm71aofW
-0ozSJ8bi/zafmGWgE07GKmSb1ZASzxQG9Dvj1Ci+6A74q05IlG2OlTEQXO2iLb3VOm2yHLtgwEZL
-AfVJrn5GitB0jaEMAs7u/OePuGtm839EAL9mJRQr3RAwHQeWP032a7iPt3sMpTjr3kfb1V05/Iin
-89cqdPHoWqI7n1C6poxFNcJQZZXcY4Lv3b93TZxiyWNzFtApD0mpSPCzqrdsxacwOUBdrsTiXSZT
-8M4cIwhhqJQZugRiQOwfOHB3EgZxpzAYXSUnpQIDAQABo4GlMIGiMA4GA1UdDwEB/wQEAwIBBjAP
-BgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBS2CHsNesysIEyGVjJez6tuhS1wVzA/BgNVHR8EODA2
-MDSgMqAwhi5odHRwOi8vd3d3Mi5wdWJsaWMtdHJ1c3QuY29tL2NybC9jdC9jdHJvb3QuY3JsMB8G
-A1UdIwQYMBaAFLYIew16zKwgTIZWMl7Pq26FLXBXMA0GCSqGSIb3DQEBBQUAA4IBAQBW7wojoFRO
-lZfJ+InaRcHUowAl9B8Tq7ejhVhpwjCt2BWKLePJzYFa+HMjWqd8BfP9IjsO0QbE2zZMcwSO5bAi
-5MXzLqXZI+O4Tkogp24CJJ8iYGd7ix1yCcUxXOl5n4BHPa2hCwcUPUf/A2kaDAtE52Mlp3+yybh2
-hO0j9n0Hq0V+09+zv+mKts2oomcrUtW3ZfA5TGOgkXmTUg9U3YO7n9GPp1Nzw8v/MOx8BLjYRB+T
-X3EJIrduPuocA06dGiBh+4E37F78CkWr1+cXVdCg6mCbpvbjjFspwgZgFJ0tl0ypkxWdYcQBX0jW
-WL1WMRJOEcgh4LMRkWXbtKaIOM5V
------END CERTIFICATE-----
-
ePKI Root Certification Authority
=================================
-----BEGIN CERTIFICATE-----
@@ -670,26 +582,6 @@ NwUASZQDhETnv0Mxz3WLJdH0pmT1kvarBes96aULNmLazAZfNou2XjG4Kvte9nHfRCaexOYNkbQu
dZWAUWpLMKawYqGT8ZvYzsRjdT9ZR7E=
-----END CERTIFICATE-----
-Hongkong Post Root CA 1
-=======================
------BEGIN CERTIFICATE-----
-MIIDMDCCAhigAwIBAgICA+gwDQYJKoZIhvcNAQEFBQAwRzELMAkGA1UEBhMCSEsxFjAUBgNVBAoT
-DUhvbmdrb25nIFBvc3QxIDAeBgNVBAMTF0hvbmdrb25nIFBvc3QgUm9vdCBDQSAxMB4XDTAzMDUx
-NTA1MTMxNFoXDTIzMDUxNTA0NTIyOVowRzELMAkGA1UEBhMCSEsxFjAUBgNVBAoTDUhvbmdrb25n
-IFBvc3QxIDAeBgNVBAMTF0hvbmdrb25nIFBvc3QgUm9vdCBDQSAxMIIBIjANBgkqhkiG9w0BAQEF
-AAOCAQ8AMIIBCgKCAQEArP84tulmAknjorThkPlAj3n54r15/gK97iSSHSL22oVyaf7XPwnU3ZG1
-ApzQjVrhVcNQhrkpJsLj2aDxaQMoIIBFIi1WpztUlVYiWR8o3x8gPW2iNr4joLFutbEnPzlTCeqr
-auh0ssJlXI6/fMN4hM2eFvz1Lk8gKgifd/PFHsSaUmYeSF7jEAaPIpjhZY4bXSNmO7ilMlHIhqqh
-qZ5/dpTCpmy3QfDVyAY45tQM4vM7TG1QjMSDJ8EThFk9nnV0ttgCXjqQesBCNnLsak3c78QA3xMY
-V18meMjWCnl3v/evt3a5pQuEF10Q6m/hq5URX208o1xNg1vysxmKgIsLhwIDAQABoyYwJDASBgNV
-HRMBAf8ECDAGAQH/AgEDMA4GA1UdDwEB/wQEAwIBxjANBgkqhkiG9w0BAQUFAAOCAQEADkbVPK7i
-h9legYsCmEEIjEy82tvuJxuC52pF7BaLT4Wg87JwvVqWuspube5Gi27nKi6Wsxkz67SfqLI37pio
-l7Yutmcn1KZJ/RyTZXaeQi/cImyaT/JaFTmxcdcrUehtHJjA2Sr0oYJ71clBoiMBdDhViw+5Lmei
-IAQ32pwL0xch4I+XeTRvhEgCIDMb5jREn5Fw9IBehEPCKdJsEhTkYY2sEJCehFC78JZvRZ+K88ps
-T/oROhUVRsPNH4NbLUES7VBnQRM9IauUiqpOfMGx+6fWtScvl6tu4B3i0RwsH0Ti/L6RoZz71ilT
-c4afU9hDDl3WY4JxHYB0yvbiAmvZWg==
------END CERTIFICATE-----
-
SecureSign RootCA11
===================
-----BEGIN CERTIFICATE-----
@@ -756,39 +648,6 @@ YIvDQVETI53O9zJrlAGomecsMx86OyXShkDOOyyGeMlhLxS67ttVb9+E7gUJTb0o2HLO02JQZR7r
kpeDMdmztcpHWD9f
-----END CERTIFICATE-----
-Autoridad de Certificacion Firmaprofesional CIF A62634068
-=========================================================
------BEGIN CERTIFICATE-----
-MIIGFDCCA/ygAwIBAgIIU+w77vuySF8wDQYJKoZIhvcNAQEFBQAwUTELMAkGA1UEBhMCRVMxQjBA
-BgNVBAMMOUF1dG9yaWRhZCBkZSBDZXJ0aWZpY2FjaW9uIEZpcm1hcHJvZmVzaW9uYWwgQ0lGIEE2
-MjYzNDA2ODAeFw0wOTA1MjAwODM4MTVaFw0zMDEyMzEwODM4MTVaMFExCzAJBgNVBAYTAkVTMUIw
-QAYDVQQDDDlBdXRvcmlkYWQgZGUgQ2VydGlmaWNhY2lvbiBGaXJtYXByb2Zlc2lvbmFsIENJRiBB
-NjI2MzQwNjgwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDKlmuO6vj78aI14H9M2uDD
-Utd9thDIAl6zQyrET2qyyhxdKJp4ERppWVevtSBC5IsP5t9bpgOSL/UR5GLXMnE42QQMcas9UX4P
-B99jBVzpv5RvwSmCwLTaUbDBPLutN0pcyvFLNg4kq7/DhHf9qFD0sefGL9ItWY16Ck6WaVICqjaY
-7Pz6FIMMNx/Jkjd/14Et5cS54D40/mf0PmbR0/RAz15iNA9wBj4gGFrO93IbJWyTdBSTo3OxDqqH
-ECNZXyAFGUftaI6SEspd/NYrspI8IM/hX68gvqB2f3bl7BqGYTM+53u0P6APjqK5am+5hyZvQWyI
-plD9amML9ZMWGxmPsu2bm8mQ9QEM3xk9Dz44I8kvjwzRAv4bVdZO0I08r0+k8/6vKtMFnXkIoctX
-MbScyJCyZ/QYFpM6/EfY0XiWMR+6KwxfXZmtY4laJCB22N/9q06mIqqdXuYnin1oKaPnirjaEbsX
-LZmdEyRG98Xi2J+Of8ePdG1asuhy9azuJBCtLxTa/y2aRnFHvkLfuwHb9H/TKI8xWVvTyQKmtFLK
-bpf7Q8UIJm+K9Lv9nyiqDdVF8xM6HdjAeI9BZzwelGSuewvF6NkBiDkal4ZkQdU7hwxu+g/GvUgU
-vzlN1J5Bto+WHWOWk9mVBngxaJ43BjuAiUVhOSPHG0SjFeUc+JIwuwIDAQABo4HvMIHsMBIGA1Ud
-EwEB/wQIMAYBAf8CAQEwDgYDVR0PAQH/BAQDAgEGMB0GA1UdDgQWBBRlzeurNR4APn7VdMActHNH
-DhpkLzCBpgYDVR0gBIGeMIGbMIGYBgRVHSAAMIGPMC8GCCsGAQUFBwIBFiNodHRwOi8vd3d3LmZp
-cm1hcHJvZmVzaW9uYWwuY29tL2NwczBcBggrBgEFBQcCAjBQHk4AUABhAHMAZQBvACAAZABlACAA
-bABhACAAQgBvAG4AYQBuAG8AdgBhACAANAA3ACAAQgBhAHIAYwBlAGwAbwBuAGEAIAAwADgAMAAx
-ADcwDQYJKoZIhvcNAQEFBQADggIBABd9oPm03cXF661LJLWhAqvdpYhKsg9VSytXjDvlMd3+xDLx
-51tkljYyGOylMnfX40S2wBEqgLk9am58m9Ot/MPWo+ZkKXzR4Tgegiv/J2Wv+xYVxC5xhOW1//qk
-R71kMrv2JYSiJ0L1ILDCExARzRAVukKQKtJE4ZYm6zFIEv0q2skGz3QeqUvVhyj5eTSSPi5E6PaP
-T481PyWzOdxjKpBrIF/EUhJOlywqrJ2X3kjyo2bbwtKDlaZmp54lD+kLM5FlClrD2VQS3a/DTg4f
-Jl4N3LON7NWBcN7STyQF82xO9UxJZo3R/9ILJUFI/lGExkKvgATP0H5kSeTy36LssUzAKh3ntLFl
-osS88Zj0qnAHY7S42jtM+kAiMFsRpvAFDsYCA0irhpuF3dvd6qJ2gHN99ZwExEWN57kci57q13XR
-crHedUTnQn3iV2t93Jm8PYMo6oCTjcVMZcFwgbg4/EMxsvYDNEeyrPsiBsse3RdHHF9mudMaotoR
-saS8I8nkvof/uZS2+F0gStRf571oe2XyFR7SOqkt6dhrJKyXWERHrVkY8SFlcN7ONGCoQPHzPKTD
-KCOM/iczQ0CgFzzr6juwcqajuUpLXhZI9LK8yIySxZ2frHI2vDSANGupi5LAuBft7HZT9SQBjLMi
-6Et8Vcad+qMUu2WFbm5PEn4KPJ2V
------END CERTIFICATE-----
-
Izenpe.com
==========
-----BEGIN CERTIFICATE-----
@@ -1037,60 +896,6 @@ tnRGEmyR7jTV7JqR50S+kDFy1UkC9gLl9B/rfNmWVan/7Ir5mUf/NVoCqgTLiluHcSmRvaS0eg29
mvVXIwAHIRc/SjnRBUkLp7Y3gaVdjKozXoEofKd9J+sAro03
-----END CERTIFICATE-----
-EC-ACC
-======
------BEGIN CERTIFICATE-----
-MIIFVjCCBD6gAwIBAgIQ7is969Qh3hSoYqwE893EATANBgkqhkiG9w0BAQUFADCB8zELMAkGA1UE
-BhMCRVMxOzA5BgNVBAoTMkFnZW5jaWEgQ2F0YWxhbmEgZGUgQ2VydGlmaWNhY2lvIChOSUYgUS0w
-ODAxMTc2LUkpMSgwJgYDVQQLEx9TZXJ2ZWlzIFB1YmxpY3MgZGUgQ2VydGlmaWNhY2lvMTUwMwYD
-VQQLEyxWZWdldSBodHRwczovL3d3dy5jYXRjZXJ0Lm5ldC92ZXJhcnJlbCAoYykwMzE1MDMGA1UE
-CxMsSmVyYXJxdWlhIEVudGl0YXRzIGRlIENlcnRpZmljYWNpbyBDYXRhbGFuZXMxDzANBgNVBAMT
-BkVDLUFDQzAeFw0wMzAxMDcyMzAwMDBaFw0zMTAxMDcyMjU5NTlaMIHzMQswCQYDVQQGEwJFUzE7
-MDkGA1UEChMyQWdlbmNpYSBDYXRhbGFuYSBkZSBDZXJ0aWZpY2FjaW8gKE5JRiBRLTA4MDExNzYt
-SSkxKDAmBgNVBAsTH1NlcnZlaXMgUHVibGljcyBkZSBDZXJ0aWZpY2FjaW8xNTAzBgNVBAsTLFZl
-Z2V1IGh0dHBzOi8vd3d3LmNhdGNlcnQubmV0L3ZlcmFycmVsIChjKTAzMTUwMwYDVQQLEyxKZXJh
-cnF1aWEgRW50aXRhdHMgZGUgQ2VydGlmaWNhY2lvIENhdGFsYW5lczEPMA0GA1UEAxMGRUMtQUND
-MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAsyLHT+KXQpWIR4NA9h0X84NzJB5R85iK
-w5K4/0CQBXCHYMkAqbWUZRkiFRfCQ2xmRJoNBD45b6VLeqpjt4pEndljkYRm4CgPukLjbo73FCeT
-ae6RDqNfDrHrZqJyTxIThmV6PttPB/SnCWDaOkKZx7J/sxaVHMf5NLWUhdWZXqBIoH7nF2W4onW4
-HvPlQn2v7fOKSGRdghST2MDk/7NQcvJ29rNdQlB50JQ+awwAvthrDk4q7D7SzIKiGGUzE3eeml0a
-E9jD2z3Il3rucO2n5nzbcc8tlGLfbdb1OL4/pYUKGbio2Al1QnDE6u/LDsg0qBIimAy4E5S2S+zw
-0JDnJwIDAQABo4HjMIHgMB0GA1UdEQQWMBSBEmVjX2FjY0BjYXRjZXJ0Lm5ldDAPBgNVHRMBAf8E
-BTADAQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUoMOLRKo3pUW/l4Ba0fF4opvpXY0wfwYD
-VR0gBHgwdjB0BgsrBgEEAfV4AQMBCjBlMCwGCCsGAQUFBwIBFiBodHRwczovL3d3dy5jYXRjZXJ0
-Lm5ldC92ZXJhcnJlbDA1BggrBgEFBQcCAjApGidWZWdldSBodHRwczovL3d3dy5jYXRjZXJ0Lm5l
-dC92ZXJhcnJlbCAwDQYJKoZIhvcNAQEFBQADggEBAKBIW4IB9k1IuDlVNZyAelOZ1Vr/sXE7zDkJ
-lF7W2u++AVtd0x7Y/X1PzaBB4DSTv8vihpw3kpBWHNzrKQXlxJ7HNd+KDM3FIUPpqojlNcAZQmNa
-Al6kSBg6hW/cnbw/nZzBh7h6YQjpdwt/cKt63dmXLGQehb+8dJahw3oS7AwaboMMPOhyRp/7SNVe
-l+axofjk70YllJyJ22k4vuxcDlbHZVHlUIiIv0LVKz3l+bqeLrPK9HOSAgu+TGbrIP65y7WZf+a2
-E/rKS03Z7lNGBjvGTq2TWoF+bCpLagVFjPIhpDGQh2xlnJ2lYJU6Un/10asIbvPuW/mIPX64b24D
-5EI=
------END CERTIFICATE-----
-
-Hellenic Academic and Research Institutions RootCA 2011
-=======================================================
------BEGIN CERTIFICATE-----
-MIIEMTCCAxmgAwIBAgIBADANBgkqhkiG9w0BAQUFADCBlTELMAkGA1UEBhMCR1IxRDBCBgNVBAoT
-O0hlbGxlbmljIEFjYWRlbWljIGFuZCBSZXNlYXJjaCBJbnN0aXR1dGlvbnMgQ2VydC4gQXV0aG9y
-aXR5MUAwPgYDVQQDEzdIZWxsZW5pYyBBY2FkZW1pYyBhbmQgUmVzZWFyY2ggSW5zdGl0dXRpb25z
-IFJvb3RDQSAyMDExMB4XDTExMTIwNjEzNDk1MloXDTMxMTIwMTEzNDk1MlowgZUxCzAJBgNVBAYT
-AkdSMUQwQgYDVQQKEztIZWxsZW5pYyBBY2FkZW1pYyBhbmQgUmVzZWFyY2ggSW5zdGl0dXRpb25z
-IENlcnQuIEF1dGhvcml0eTFAMD4GA1UEAxM3SGVsbGVuaWMgQWNhZGVtaWMgYW5kIFJlc2VhcmNo
-IEluc3RpdHV0aW9ucyBSb290Q0EgMjAxMTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEB
-AKlTAOMupvaO+mDYLZU++CwqVE7NuYRhlFhPjz2L5EPzdYmNUeTDN9KKiE15HrcS3UN4SoqS5tdI
-1Q+kOilENbgH9mgdVc04UfCMJDGFr4PJfel3r+0ae50X+bOdOFAPplp5kYCvN66m0zH7tSYJnTxa
-71HFK9+WXesyHgLacEnsbgzImjeN9/E2YEsmLIKe0HjzDQ9jpFEw4fkrJxIH2Oq9GGKYsFk3fb7u
-8yBRQlqD75O6aRXxYp2fmTmCobd0LovUxQt7L/DICto9eQqakxylKHJzkUOap9FNhYS5qXSPFEDH
-3N6sQWRstBmbAmNtJGSPRLIl6s5ddAxjMlyNh+UCAwEAAaOBiTCBhjAPBgNVHRMBAf8EBTADAQH/
-MAsGA1UdDwQEAwIBBjAdBgNVHQ4EFgQUppFC/RNhSiOeCKQp5dgTBCPuQSUwRwYDVR0eBEAwPqA8
-MAWCAy5ncjAFggMuZXUwBoIELmVkdTAGggQub3JnMAWBAy5ncjAFgQMuZXUwBoEELmVkdTAGgQQu
-b3JnMA0GCSqGSIb3DQEBBQUAA4IBAQAf73lB4XtuP7KMhjdCSk4cNx6NZrokgclPEg8hwAOXhiVt
-XdMiKahsog2p6z0GW5k6x8zDmjR/qw7IThzh+uTczQ2+vyT+bOdrwg3IBp5OjWEopmr95fZi6hg8
-TqBTnbI6nOulnJEWtk2C4AwFSKls9cz4y51JtPACpf1wA+2KIaWuE4ZJwzNzvoc7dIsXRSZMFpGD
-/md9zU1jZ/rzAxKWeAaNsWftjj++n08C9bMJL/NMh98qy5V8AcysNnq/onN694/BtZqhFLKPM58N
-7yLcZnuEvUUXBj08yrl3NI/K6s8/MT7jiOOASSXIl7WdmplNsDz4SgCbZN2fOUvRJ9e4
------END CERTIFICATE-----
-
Actalis Authentication Root CA
==============================
-----BEGIN CERTIFICATE-----
@@ -1382,40 +1187,6 @@ Y2XQ8xwOFvVrhlhNGNTkDY6lnVuR3HYkUD/GKvvZt5y11ubQ2egZixVxSK236thZiNSQvxaz2ems
WWFUyBy6ysHK4bkgTI86k4mloMy/0/Z1pHWWbVY=
-----END CERTIFICATE-----
-E-Tugra Certification Authority
-===============================
------BEGIN CERTIFICATE-----
-MIIGSzCCBDOgAwIBAgIIamg+nFGby1MwDQYJKoZIhvcNAQELBQAwgbIxCzAJBgNVBAYTAlRSMQ8w
-DQYDVQQHDAZBbmthcmExQDA+BgNVBAoMN0UtVHXEn3JhIEVCRyBCaWxpxZ9pbSBUZWtub2xvamls
-ZXJpIHZlIEhpem1ldGxlcmkgQS7Fni4xJjAkBgNVBAsMHUUtVHVncmEgU2VydGlmaWthc3lvbiBN
-ZXJrZXppMSgwJgYDVQQDDB9FLVR1Z3JhIENlcnRpZmljYXRpb24gQXV0aG9yaXR5MB4XDTEzMDMw
-NTEyMDk0OFoXDTIzMDMwMzEyMDk0OFowgbIxCzAJBgNVBAYTAlRSMQ8wDQYDVQQHDAZBbmthcmEx
-QDA+BgNVBAoMN0UtVHXEn3JhIEVCRyBCaWxpxZ9pbSBUZWtub2xvamlsZXJpIHZlIEhpem1ldGxl
-cmkgQS7Fni4xJjAkBgNVBAsMHUUtVHVncmEgU2VydGlmaWthc3lvbiBNZXJrZXppMSgwJgYDVQQD
-DB9FLVR1Z3JhIENlcnRpZmljYXRpb24gQXV0aG9yaXR5MIICIjANBgkqhkiG9w0BAQEFAAOCAg8A
-MIICCgKCAgEA4vU/kwVRHoViVF56C/UYB4Oufq9899SKa6VjQzm5S/fDxmSJPZQuVIBSOTkHS0vd
-hQd2h8y/L5VMzH2nPbxHD5hw+IyFHnSOkm0bQNGZDbt1bsipa5rAhDGvykPL6ys06I+XawGb1Q5K
-CKpbknSFQ9OArqGIW66z6l7LFpp3RMih9lRozt6Plyu6W0ACDGQXwLWTzeHxE2bODHnv0ZEoq1+g
-ElIwcxmOj+GMB6LDu0rw6h8VqO4lzKRG+Bsi77MOQ7osJLjFLFzUHPhdZL3Dk14opz8n8Y4e0ypQ
-BaNV2cvnOVPAmJ6MVGKLJrD3fY185MaeZkJVgkfnsliNZvcHfC425lAcP9tDJMW/hkd5s3kc91r0
-E+xs+D/iWR+V7kI+ua2oMoVJl0b+SzGPWsutdEcf6ZG33ygEIqDUD13ieU/qbIWGvaimzuT6w+Gz
-rt48Ue7LE3wBf4QOXVGUnhMMti6lTPk5cDZvlsouDERVxcr6XQKj39ZkjFqzAQqptQpHF//vkUAq
-jqFGOjGY5RH8zLtJVor8udBhmm9lbObDyz51Sf6Pp+KJxWfXnUYTTjF2OySznhFlhqt/7x3U+Lzn
-rFpct1pHXFXOVbQicVtbC/DP3KBhZOqp12gKY6fgDT+gr9Oq0n7vUaDmUStVkhUXU8u3Zg5mTPj5
-dUyQ5xJwx0UCAwEAAaNjMGEwHQYDVR0OBBYEFC7j27JJ0JxUeVz6Jyr+zE7S6E5UMA8GA1UdEwEB
-/wQFMAMBAf8wHwYDVR0jBBgwFoAULuPbsknQnFR5XPonKv7MTtLoTlQwDgYDVR0PAQH/BAQDAgEG
-MA0GCSqGSIb3DQEBCwUAA4ICAQAFNzr0TbdF4kV1JI+2d1LoHNgQk2Xz8lkGpD4eKexd0dCrfOAK
-kEh47U6YA5n+KGCRHTAduGN8qOY1tfrTYXbm1gdLymmasoR6d5NFFxWfJNCYExL/u6Au/U5Mh/jO
-XKqYGwXgAEZKgoClM4so3O0409/lPun++1ndYYRP0lSWE2ETPo+Aab6TR7U1Q9Jauz1c77NCR807
-VRMGsAnb/WP2OogKmW9+4c4bU2pEZiNRCHu8W1Ki/QY3OEBhj0qWuJA3+GbHeJAAFS6LrVE1Uweo
-a2iu+U48BybNCAVwzDk/dr2l02cmAYamU9JgO3xDf1WKvJUawSg5TB9D0pH0clmKuVb8P7Sd2nCc
-dlqMQ1DujjByTd//SffGqWfZbawCEeI6FiWnWAjLb1NBnEg4R2gz0dfHj9R0IdTDBZB6/86WiLEV
-KV0jq9BgoRJP3vQXzTLlyb/IQ639Lo7xr+L0mPoSHyDYwKcMhcWQ9DstliaxLL5Mq+ux0orJ23gT
-Dx4JnW2PAJ8C2sH6H3p6CcRK5ogql5+Ji/03X186zjhZhkuvcQu02PJwT58yE+Owp1fl2tpDy4Q0
-8ijE6m30Ku/Ba3ba+367hTzSU8JNvnHhRdH9I2cNE3X7z2VnIp2usAnRCf8dNL/+I5c30jn6PQ0G
-C7TbO6Orb1wdtn7os4I07QZcJA==
------END CERTIFICATE-----
-
T-TeleSec GlobalRoot Class 2
============================
-----BEGIN CERTIFICATE-----
@@ -1737,20 +1508,6 @@ HU6+4WMBzzuqQhFkoJ2UOQIReVx7Hfpkue4WQrO/isIJxOzksU0CMQDpKmFHjFJKS04YcPbWRNZu
9YO6bVi9JNlWSOrvxKJGgYhqOkbRqZtNyWHa0V1Xahg=
-----END CERTIFICATE-----
-GlobalSign ECC Root CA - R4
-===========================
------BEGIN CERTIFICATE-----
-MIIB4TCCAYegAwIBAgIRKjikHJYKBN5CsiilC+g0mAIwCgYIKoZIzj0EAwIwUDEkMCIGA1UECxMb
-R2xvYmFsU2lnbiBFQ0MgUm9vdCBDQSAtIFI0MRMwEQYDVQQKEwpHbG9iYWxTaWduMRMwEQYDVQQD
-EwpHbG9iYWxTaWduMB4XDTEyMTExMzAwMDAwMFoXDTM4MDExOTAzMTQwN1owUDEkMCIGA1UECxMb
-R2xvYmFsU2lnbiBFQ0MgUm9vdCBDQSAtIFI0MRMwEQYDVQQKEwpHbG9iYWxTaWduMRMwEQYDVQQD
-EwpHbG9iYWxTaWduMFkwEwYHKoZIzj0CAQYIKoZIzj0DAQcDQgAEuMZ5049sJQ6fLjkZHAOkrprl
-OQcJFspjsbmG+IpXwVfOQvpzofdlQv8ewQCybnMO/8ch5RikqtlxP6jUuc6MHaNCMEAwDgYDVR0P
-AQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFFSwe61FuOJAf/sKbvu+M8k8o4TV
-MAoGCCqGSM49BAMCA0gAMEUCIQDckqGgE6bPA7DmxCGXkPoUVy0D7O48027KqGx2vKLeuwIgJ6iF
-JzWbVsaj8kfSt24bAgAXqmemFZHe+pTsewv4n4Q=
------END CERTIFICATE-----
-
GlobalSign ECC Root CA - R5
===========================
-----BEGIN CERTIFICATE-----
@@ -1766,36 +1523,6 @@ uglB4Zf4+/2a4n0Sye18ZNPLBSWLVtmg515dTguDnFt2KaAJJiFqYgIwcdK1j1zqO+F4CYWodZI7
yFz9SO8NdCKoCOJuxUnOxwy8p2Fp8fc74SrL+SvzZpA3
-----END CERTIFICATE-----
-Staat der Nederlanden EV Root CA
-================================
------BEGIN CERTIFICATE-----
-MIIFcDCCA1igAwIBAgIEAJiWjTANBgkqhkiG9w0BAQsFADBYMQswCQYDVQQGEwJOTDEeMBwGA1UE
-CgwVU3RhYXQgZGVyIE5lZGVybGFuZGVuMSkwJwYDVQQDDCBTdGFhdCBkZXIgTmVkZXJsYW5kZW4g
-RVYgUm9vdCBDQTAeFw0xMDEyMDgxMTE5MjlaFw0yMjEyMDgxMTEwMjhaMFgxCzAJBgNVBAYTAk5M
-MR4wHAYDVQQKDBVTdGFhdCBkZXIgTmVkZXJsYW5kZW4xKTAnBgNVBAMMIFN0YWF0IGRlciBOZWRl
-cmxhbmRlbiBFViBSb290IENBMIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEA48d+ifkk
-SzrSM4M1LGns3Amk41GoJSt5uAg94JG6hIXGhaTK5skuU6TJJB79VWZxXSzFYGgEt9nCUiY4iKTW
-O0Cmws0/zZiTs1QUWJZV1VD+hq2kY39ch/aO5ieSZxeSAgMs3NZmdO3dZ//BYY1jTw+bbRcwJu+r
-0h8QoPnFfxZpgQNH7R5ojXKhTbImxrpsX23Wr9GxE46prfNeaXUmGD5BKyF/7otdBwadQ8QpCiv8
-Kj6GyzyDOvnJDdrFmeK8eEEzduG/L13lpJhQDBXd4Pqcfzho0LKmeqfRMb1+ilgnQ7O6M5HTp5gV
-XJrm0w912fxBmJc+qiXbj5IusHsMX/FjqTf5m3VpTCgmJdrV8hJwRVXj33NeN/UhbJCONVrJ0yPr
-08C+eKxCKFhmpUZtcALXEPlLVPxdhkqHz3/KRawRWrUgUY0viEeXOcDPusBCAUCZSCELa6fS/ZbV
-0b5GnUngC6agIk440ME8MLxwjyx1zNDFjFE7PZQIZCZhfbnDZY8UnCHQqv0XcgOPvZuM5l5Tnrmd
-74K74bzickFbIZTTRTeU0d8JOV3nI6qaHcptqAqGhYqCvkIH1vI4gnPah1vlPNOePqc7nvQDs/nx
-fRN0Av+7oeX6AHkcpmZBiFxgV6YuCcS6/ZrPpx9Aw7vMWgpVSzs4dlG4Y4uElBbmVvMCAwEAAaNC
-MEAwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0OBBYEFP6rAJCYniT8qcwa
-ivsnuL8wbqg7MA0GCSqGSIb3DQEBCwUAA4ICAQDPdyxuVr5Os7aEAJSrR8kN0nbHhp8dB9O2tLsI
-eK9p0gtJ3jPFrK3CiAJ9Brc1AsFgyb/E6JTe1NOpEyVa/m6irn0F3H3zbPB+po3u2dfOWBfoqSmu
-c0iH55vKbimhZF8ZE/euBhD/UcabTVUlT5OZEAFTdfETzsemQUHSv4ilf0X8rLiltTMMgsT7B/Zq
-5SWEXwbKwYY5EdtYzXc7LMJMD16a4/CrPmEbUCTCwPTxGfARKbalGAKb12NMcIxHowNDXLldRqAN
-b/9Zjr7dn3LDWyvfjFvO5QxGbJKyCqNMVEIYFRIYvdr8unRu/8G2oGTYqV9Vrp9canaW2HNnh/tN
-f1zuacpzEPuKqf2evTY4SUmH9A4U8OmHuD+nT3pajnnUk+S7aFKErGzp85hwVXIy+TSrK0m1zSBi
-5Dp6Z2Orltxtrpfs/J92VoguZs9btsmksNcFuuEnL5O7Jiqik7Ab846+HUCjuTaPPoIaGl6I6lD4
-WeKDRikL40Rc4ZW2aZCaFG+XroHPaO+Zmr615+F/+PoTRxZMzG0IQOeLeG9QgkRQP2YGiqtDhFZK
-DyAthg710tvSeopLzaXoTvFeJiUBWSOgftL2fiFX1ye8FVdMpEbB4IMeDExNH08GGeL5qPQ6gqGy
-eUN51q1veieQA6TqJIc/2b3Z6fJfUEkc7uzXLg==
------END CERTIFICATE-----
-
IdenTrust Commercial Root CA 1
==============================
-----BEGIN CERTIFICATE-----
@@ -2247,87 +1974,6 @@ F8Io2c9Si1vIY9RCPqAzekYu9wogRlR+ak8x8YF+QnQ4ZXMn7sZ8uI7XpTrXmKGcjBBV09tL7ECQ
aaApJUqlyyvdimYHFngVV3Eb7PVHhPOeMTd61X8kreS8/f3MboPoDKi3QWwH3b08hpcv0g==
-----END CERTIFICATE-----
-TrustCor RootCert CA-1
-======================
------BEGIN CERTIFICATE-----
-MIIEMDCCAxigAwIBAgIJANqb7HHzA7AZMA0GCSqGSIb3DQEBCwUAMIGkMQswCQYDVQQGEwJQQTEP
-MA0GA1UECAwGUGFuYW1hMRQwEgYDVQQHDAtQYW5hbWEgQ2l0eTEkMCIGA1UECgwbVHJ1c3RDb3Ig
-U3lzdGVtcyBTLiBkZSBSLkwuMScwJQYDVQQLDB5UcnVzdENvciBDZXJ0aWZpY2F0ZSBBdXRob3Jp
-dHkxHzAdBgNVBAMMFlRydXN0Q29yIFJvb3RDZXJ0IENBLTEwHhcNMTYwMjA0MTIzMjE2WhcNMjkx
-MjMxMTcyMzE2WjCBpDELMAkGA1UEBhMCUEExDzANBgNVBAgMBlBhbmFtYTEUMBIGA1UEBwwLUGFu
-YW1hIENpdHkxJDAiBgNVBAoMG1RydXN0Q29yIFN5c3RlbXMgUy4gZGUgUi5MLjEnMCUGA1UECwwe
-VHJ1c3RDb3IgQ2VydGlmaWNhdGUgQXV0aG9yaXR5MR8wHQYDVQQDDBZUcnVzdENvciBSb290Q2Vy
-dCBDQS0xMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAv463leLCJhJrMxnHQFgKq1mq
-jQCj/IDHUHuO1CAmujIS2CNUSSUQIpidRtLByZ5OGy4sDjjzGiVoHKZaBeYei0i/mJZ0PmnK6bV4
-pQa81QBeCQryJ3pS/C3Vseq0iWEk8xoT26nPUu0MJLq5nux+AHT6k61sKZKuUbS701e/s/OojZz0
-JEsq1pme9J7+wH5COucLlVPat2gOkEz7cD+PSiyU8ybdY2mplNgQTsVHCJCZGxdNuWxu72CVEY4h
-gLW9oHPY0LJ3xEXqWib7ZnZ2+AYfYW0PVcWDtxBWcgYHpfOxGgMFZA6dWorWhnAbJN7+KIor0Gqw
-/Hqi3LJ5DotlDwIDAQABo2MwYTAdBgNVHQ4EFgQU7mtJPHo/DeOxCbeKyKsZn3MzUOcwHwYDVR0j
-BBgwFoAU7mtJPHo/DeOxCbeKyKsZn3MzUOcwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMC
-AYYwDQYJKoZIhvcNAQELBQADggEBACUY1JGPE+6PHh0RU9otRCkZoB5rMZ5NDp6tPVxBb5UrJKF5
-mDo4Nvu7Zp5I/5CQ7z3UuJu0h3U/IJvOcs+hVcFNZKIZBqEHMwwLKeXx6quj7LUKdJDHfXLy11yf
-ke+Ri7fc7Waiz45mO7yfOgLgJ90WmMCV1Aqk5IGadZQ1nJBfiDcGrVmVCrDRZ9MZyonnMlo2HD6C
-qFqTvsbQZJG2z9m2GM/bftJlo6bEjhcxwft+dtvTheNYsnd6djtsL1Ac59v2Z3kf9YKVmgenFK+P
-3CghZwnS1k1aHBkcjndcw5QkPTJrS37UeJSDvjdNzl/HHk484IkzlQsPpTLWPFp5LBk=
------END CERTIFICATE-----
-
-TrustCor RootCert CA-2
-======================
------BEGIN CERTIFICATE-----
-MIIGLzCCBBegAwIBAgIIJaHfyjPLWQIwDQYJKoZIhvcNAQELBQAwgaQxCzAJBgNVBAYTAlBBMQ8w
-DQYDVQQIDAZQYW5hbWExFDASBgNVBAcMC1BhbmFtYSBDaXR5MSQwIgYDVQQKDBtUcnVzdENvciBT
-eXN0ZW1zIFMuIGRlIFIuTC4xJzAlBgNVBAsMHlRydXN0Q29yIENlcnRpZmljYXRlIEF1dGhvcml0
-eTEfMB0GA1UEAwwWVHJ1c3RDb3IgUm9vdENlcnQgQ0EtMjAeFw0xNjAyMDQxMjMyMjNaFw0zNDEy
-MzExNzI2MzlaMIGkMQswCQYDVQQGEwJQQTEPMA0GA1UECAwGUGFuYW1hMRQwEgYDVQQHDAtQYW5h
-bWEgQ2l0eTEkMCIGA1UECgwbVHJ1c3RDb3IgU3lzdGVtcyBTLiBkZSBSLkwuMScwJQYDVQQLDB5U
-cnVzdENvciBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkxHzAdBgNVBAMMFlRydXN0Q29yIFJvb3RDZXJ0
-IENBLTIwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCnIG7CKqJiJJWQdsg4foDSq8Gb
-ZQWU9MEKENUCrO2fk8eHyLAnK0IMPQo+QVqedd2NyuCb7GgypGmSaIwLgQ5WoD4a3SwlFIIvl9Nk
-RvRUqdw6VC0xK5mC8tkq1+9xALgxpL56JAfDQiDyitSSBBtlVkxs1Pu2YVpHI7TYabS3OtB0PAx1
-oYxOdqHp2yqlO/rOsP9+aij9JxzIsekp8VduZLTQwRVtDr4uDkbIXvRR/u8OYzo7cbrPb1nKDOOb
-XUm4TOJXsZiKQlecdu/vvdFoqNL0Cbt3Nb4lggjEFixEIFapRBF37120Hapeaz6LMvYHL1cEksr1
-/p3C6eizjkxLAjHZ5DxIgif3GIJ2SDpxsROhOdUuxTTCHWKF3wP+TfSvPd9cW436cOGlfifHhi5q
-jxLGhF5DUVCcGZt45vz27Ud+ez1m7xMTiF88oWP7+ayHNZ/zgp6kPwqcMWmLmaSISo5uZk3vFsQP
-eSghYA2FFn3XVDjxklb9tTNMg9zXEJ9L/cb4Qr26fHMC4P99zVvh1Kxhe1fVSntb1IVYJ12/+Ctg
-rKAmrhQhJ8Z3mjOAPF5GP/fDsaOGM8boXg25NSyqRsGFAnWAoOsk+xWq5Gd/bnc/9ASKL3x74xdh
-8N0JqSDIvgmk0H5Ew7IwSjiqqewYmgeCK9u4nBit2uBGF6zPXQIDAQABo2MwYTAdBgNVHQ4EFgQU
-2f4hQG6UnrybPZx9mCAZ5YwwYrIwHwYDVR0jBBgwFoAU2f4hQG6UnrybPZx9mCAZ5YwwYrIwDwYD
-VR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAYYwDQYJKoZIhvcNAQELBQADggIBAJ5Fngw7tu/h
-Osh80QA9z+LqBrWyOrsGS2h60COXdKcs8AjYeVrXWoSK2BKaG9l9XE1wxaX5q+WjiYndAfrs3fnp
-kpfbsEZC89NiqpX+MWcUaViQCqoL7jcjx1BRtPV+nuN79+TMQjItSQzL/0kMmx40/W5ulop5A7Zv
-2wnL/V9lFDfhOPXzYRZY5LVtDQsEGz9QLX+zx3oaFoBg+Iof6Rsqxvm6ARppv9JYx1RXCI/hOWB3
-S6xZhBqI8d3LT3jX5+EzLfzuQfogsL7L9ziUwOHQhQ+77Sxzq+3+knYaZH9bDTMJBzN7Bj8RpFxw
-PIXAz+OQqIN3+tvmxYxoZxBnpVIt8MSZj3+/0WvitUfW2dCFmU2Umw9Lje4AWkcdEQOsQRivh7dv
-DDqPys/cA8GiCcjl/YBeyGBCARsaU1q7N6a3vLqE6R5sGtRk2tRD/pOLS/IseRYQ1JMLiI+h2IYU
-RpFHmygk71dSTlxCnKr3Sewn6EAes6aJInKc9Q0ztFijMDvd1GpUk74aTfOTlPf8hAs/hCBcNANE
-xdqtvArBAs8e5ZTZ845b2EzwnexhF7sUMlQMAimTHpKG9n/v55IFDlndmQguLvqcAFLTxWYp5KeX
-RKQOKIETNcX2b2TmQcTVL8w0RSXPQQCWPUouwpaYT05KnJe32x+SMsj/D1Fu1uwJ
------END CERTIFICATE-----
-
-TrustCor ECA-1
-==============
------BEGIN CERTIFICATE-----
-MIIEIDCCAwigAwIBAgIJAISCLF8cYtBAMA0GCSqGSIb3DQEBCwUAMIGcMQswCQYDVQQGEwJQQTEP
-MA0GA1UECAwGUGFuYW1hMRQwEgYDVQQHDAtQYW5hbWEgQ2l0eTEkMCIGA1UECgwbVHJ1c3RDb3Ig
-U3lzdGVtcyBTLiBkZSBSLkwuMScwJQYDVQQLDB5UcnVzdENvciBDZXJ0aWZpY2F0ZSBBdXRob3Jp
-dHkxFzAVBgNVBAMMDlRydXN0Q29yIEVDQS0xMB4XDTE2MDIwNDEyMzIzM1oXDTI5MTIzMTE3Mjgw
-N1owgZwxCzAJBgNVBAYTAlBBMQ8wDQYDVQQIDAZQYW5hbWExFDASBgNVBAcMC1BhbmFtYSBDaXR5
-MSQwIgYDVQQKDBtUcnVzdENvciBTeXN0ZW1zIFMuIGRlIFIuTC4xJzAlBgNVBAsMHlRydXN0Q29y
-IENlcnRpZmljYXRlIEF1dGhvcml0eTEXMBUGA1UEAwwOVHJ1c3RDb3IgRUNBLTEwggEiMA0GCSqG
-SIb3DQEBAQUAA4IBDwAwggEKAoIBAQDPj+ARtZ+odnbb3w9U73NjKYKtR8aja+3+XzP4Q1HpGjOR
-MRegdMTUpwHmspI+ap3tDvl0mEDTPwOABoJA6LHip1GnHYMma6ve+heRK9jGrB6xnhkB1Zem6g23
-xFUfJ3zSCNV2HykVh0A53ThFEXXQmqc04L/NyFIduUd+Dbi7xgz2c1cWWn5DkR9VOsZtRASqnKmc
-p0yJF4OuowReUoCLHhIlERnXDH19MURB6tuvsBzvgdAsxZohmz3tQjtQJvLsznFhBmIhVE5/wZ0+
-fyCMgMsq2JdiyIMzkX2woloPV+g7zPIlstR8L+xNxqE6FXrntl019fZISjZFZtS6mFjBAgMBAAGj
-YzBhMB0GA1UdDgQWBBREnkj1zG1I1KBLf/5ZJC+Dl5mahjAfBgNVHSMEGDAWgBREnkj1zG1I1KBL
-f/5ZJC+Dl5mahjAPBgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBhjANBgkqhkiG9w0BAQsF
-AAOCAQEABT41XBVwm8nHc2FvcivUwo/yQ10CzsSUuZQRg2dd4mdsdXa/uwyqNsatR5Nj3B5+1t4u
-/ukZMjgDfxT2AHMsWbEhBuH7rBiVDKP/mZb3Kyeb1STMHd3BOuCYRLDE5D53sXOpZCz2HAF8P11F
-hcCF5yWPldwX8zyfGm6wyuMdKulMY/okYWLW2n62HGz1Ah3UKt1VkOsqEUc8Ll50soIipX1TH0Xs
-J5F95yIW6MBoNtjG8U+ARDL54dHRHareqKucBK+tIA5kmE2la8BIWJZpTdwHjFGTot+fDz2LYLSC
-jaoITmJF4PkL0uDgPFveXHEnJcLmA4GLEFPjx1WitJ/X5g==
------END CERTIFICATE-----
-
SSL.com Root Certification Authority RSA
========================================
-----BEGIN CERTIFICATE-----
@@ -2472,96 +2118,6 @@ AwMDaAAwZQIwJsdpW9zV57LnyAyMjMPdeYwbY9XJUpROTYJKcx6ygISpJcBMWm1JKWB4E+J+SOtk
AjEA2zQgMgj/mkkCtojeFK9dbJlxjRo/i9fgojaGHAeCOnZT/cKi7e97sIBPWA9LUzm9
-----END CERTIFICATE-----
-GTS Root R1
-===========
------BEGIN CERTIFICATE-----
-MIIFWjCCA0KgAwIBAgIQbkepxUtHDA3sM9CJuRz04TANBgkqhkiG9w0BAQwFADBHMQswCQYDVQQG
-EwJVUzEiMCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJv
-b3QgUjEwHhcNMTYwNjIyMDAwMDAwWhcNMzYwNjIyMDAwMDAwWjBHMQswCQYDVQQGEwJVUzEiMCAG
-A1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjEwggIi
-MA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQC2EQKLHuOhd5s73L+UPreVp0A8of2C+X0yBoJx
-9vaMf/vo27xqLpeXo4xL+Sv2sfnOhB2x+cWX3u+58qPpvBKJXqeqUqv4IyfLpLGcY9vXmX7wCl7r
-aKb0xlpHDU0QM+NOsROjyBhsS+z8CZDfnWQpJSMHobTSPS5g4M/SCYe7zUjwTcLCeoiKu7rPWRnW
-r4+wB7CeMfGCwcDfLqZtbBkOtdh+JhpFAz2weaSUKK0PfyblqAj+lug8aJRT7oM6iCsVlgmy4HqM
-LnXWnOunVmSPlk9orj2XwoSPwLxAwAtcvfaHszVsrBhQf4TgTM2S0yDpM7xSma8ytSmzJSq0SPly
-4cpk9+aCEI3oncKKiPo4Zor8Y/kB+Xj9e1x3+naH+uzfsQ55lVe0vSbv1gHR6xYKu44LtcXFilWr
-06zqkUspzBmkMiVOKvFlRNACzqrOSbTqn3yDsEB750Orp2yjj32JgfpMpf/VjsPOS+C12LOORc92
-wO1AK/1TD7Cn1TsNsYqiA94xrcx36m97PtbfkSIS5r762DL8EGMUUXLeXdYWk70paDPvOmbsB4om
-3xPXV2V4J95eSRQAogB/mqghtqmxlbCluQ0WEdrHbEg8QOB+DVrNVjzRlwW5y0vtOUucxD/SVRNu
-JLDWcfr0wbrM7Rv1/oFB2ACYPTrIrnqYNxgFlQIDAQABo0IwQDAOBgNVHQ8BAf8EBAMCAQYwDwYD
-VR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQU5K8rJnEaK0gnhS9SZizv8IkTcT4wDQYJKoZIhvcNAQEM
-BQADggIBADiWCu49tJYeX++dnAsznyvgyv3SjgofQXSlfKqE1OXyHuY3UjKcC9FhHb8owbZEKTV1
-d5iyfNm9dKyKaOOpMQkpAWBz40d8U6iQSifvS9efk+eCNs6aaAyC58/UEBZvXw6ZXPYfcX3v73sv
-fuo21pdwCxXu11xWajOl40k4DLh9+42FpLFZXvRq4d2h9mREruZRgyFmxhE+885H7pwoHyXa/6xm
-ld01D1zvICxi/ZG6qcz8WpyTgYMpl0p8WnK0OdC3d8t5/Wk6kjftbjhlRn7pYL15iJdfOBL07q9b
-gsiG1eGZbYwE8na6SfZu6W0eX6DvJ4J2QPim01hcDyxC2kLGe4g0x8HYRZvBPsVhHdljUEn2NIVq
-4BjFbkerQUIpm/ZgDdIx02OYI5NaAIFItO/Nis3Jz5nu2Z6qNuFoS3FJFDYoOj0dzpqPJeaAcWEr
-tXvM+SUWgeExX6GjfhaknBZqlxi9dnKlC54dNuYvoS++cJEPqOba+MSSQGwlfnuzCdyyF62ARPBo
-pY+Udf90WuioAnwMCeKpSwughQtiue+hMZL77/ZRBIls6Kl0obsXs7X9SQ98POyDGCBDTtWTurQ0
-sR8WNh8M5mQ5Fkzc4P4dyKliPUDqysU0ArSuiYgzNdwsE3PYJ/HQcu51OyLemGhmW/HGY0dVHLql
-CFF1pkgl
------END CERTIFICATE-----
-
-GTS Root R2
-===========
------BEGIN CERTIFICATE-----
-MIIFWjCCA0KgAwIBAgIQbkepxlqz5yDFMJo/aFLybzANBgkqhkiG9w0BAQwFADBHMQswCQYDVQQG
-EwJVUzEiMCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJv
-b3QgUjIwHhcNMTYwNjIyMDAwMDAwWhcNMzYwNjIyMDAwMDAwWjBHMQswCQYDVQQGEwJVUzEiMCAG
-A1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjIwggIi
-MA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDO3v2m++zsFDQ8BwZabFn3GTXd98GdVarTzTuk
-k3LvCvptnfbwhYBboUhSnznFt+4orO/LdmgUud+tAWyZH8QiHZ/+cnfgLFuv5AS/T3KgGjSY6Dlo
-7JUle3ah5mm5hRm9iYz+re026nO8/4Piy33B0s5Ks40FnotJk9/BW9BuXvAuMC6C/Pq8tBcKSOWI
-m8Wba96wyrQD8Nr0kLhlZPdcTK3ofmZemde4wj7I0BOdre7kRXuJVfeKH2JShBKzwkCX44ofR5Gm
-dFrS+LFjKBC4swm4VndAoiaYecb+3yXuPuWgf9RhD1FLPD+M2uFwdNjCaKH5wQzpoeJ/u1U8dgbu
-ak7MkogwTZq9TwtImoS1mKPV+3PBV2HdKFZ1E66HjucMUQkQdYhMvI35ezzUIkgfKtzra7tEscsz
-cTJGr61K8YzodDqs5xoic4DSMPclQsciOzsSrZYuxsN2B6ogtzVJV+mSSeh2FnIxZyuWfoqjx5RW
-Ir9qS34BIbIjMt/kmkRtWVtd9QCgHJvGeJeNkP+byKq0rxFROV7Z+2et1VsRnTKaG73Vululycsl
-aVNVJ1zgyjbLiGH7HrfQy+4W+9OmTN6SpdTi3/UGVN4unUu0kzCqgc7dGtxRcw1PcOnlthYhGXmy
-5okLdWTK1au8CcEYof/UVKGFPP0UJAOyh9OktwIDAQABo0IwQDAOBgNVHQ8BAf8EBAMCAQYwDwYD
-VR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQUu//KjiOfT5nK2+JopqUVJxce2Q4wDQYJKoZIhvcNAQEM
-BQADggIBALZp8KZ3/p7uC4Gt4cCpx/k1HUCCq+YEtN/L9x0Pg/B+E02NjO7jMyLDOfxA325BS0JT
-vhaI8dI4XsRomRyYUpOM52jtG2pzegVATX9lO9ZY8c6DR2Dj/5epnGB3GFW1fgiTz9D2PGcDFWEJ
-+YF59exTpJ/JjwGLc8R3dtyDovUMSRqodt6Sm2T4syzFJ9MHwAiApJiS4wGWAqoC7o87xdFtCjMw
-c3i5T1QWvwsHoaRc5svJXISPD+AVdyx+Jn7axEvbpxZ3B7DNdehyQtaVhJ2Gg/LkkM0JR9SLA3Da
-WsYDQvTtN6LwG1BUSw7YhN4ZKJmBR64JGz9I0cNv4rBgF/XuIwKl2gBbbZCr7qLpGzvpx0QnRY5r
-n/WkhLx3+WuXrD5RRaIRpsyF7gpo8j5QOHokYh4XIDdtak23CZvJ/KRY9bb7nE4Yu5UC56Gtmwfu
-Nmsk0jmGwZODUNKBRqhfYlcsu2xkiAhu7xNUX90txGdj08+JN7+dIPT7eoOboB6BAFDC5AwiWVIQ
-7UNWhwD4FFKnHYuTjKJNRn8nxnGbJN7k2oaLDX5rIMHAnuFl2GqjpuiFizoHCBy69Y9Vmhh1fuXs
-gWbRIXOhNUQLgD1bnF5vKheW0YMjiGZt5obicDIvUiLnyOd/xCxgXS/Dr55FBcOEArf9LAhST4Ld
-o/DUhgkC
------END CERTIFICATE-----
-
-GTS Root R3
-===========
------BEGIN CERTIFICATE-----
-MIICDDCCAZGgAwIBAgIQbkepx2ypcyRAiQ8DVd2NHTAKBggqhkjOPQQDAzBHMQswCQYDVQQGEwJV
-UzEiMCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3Qg
-UjMwHhcNMTYwNjIyMDAwMDAwWhcNMzYwNjIyMDAwMDAwWjBHMQswCQYDVQQGEwJVUzEiMCAGA1UE
-ChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjMwdjAQBgcq
-hkjOPQIBBgUrgQQAIgNiAAQfTzOHMymKoYTey8chWEGJ6ladK0uFxh1MJ7x/JlFyb+Kf1qPKzEUU
-Rout736GjOyxfi//qXGdGIRFBEFVbivqJn+7kAHjSxm65FSWRQmx1WyRRK2EE46ajA2ADDL24Cej
-QjBAMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBTB8Sa6oC2uhYHP
-0/EqEr24Cmf9vDAKBggqhkjOPQQDAwNpADBmAjEAgFukfCPAlaUs3L6JbyO5o91lAFJekazInXJ0
-glMLfalAvWhgxeG4VDvBNhcl2MG9AjEAnjWSdIUlUfUk7GRSJFClH9voy8l27OyCbvWFGFPouOOa
-KaqW04MjyaR7YbPMAuhd
------END CERTIFICATE-----
-
-GTS Root R4
-===========
------BEGIN CERTIFICATE-----
-MIICCjCCAZGgAwIBAgIQbkepyIuUtui7OyrYorLBmTAKBggqhkjOPQQDAzBHMQswCQYDVQQGEwJV
-UzEiMCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3Qg
-UjQwHhcNMTYwNjIyMDAwMDAwWhcNMzYwNjIyMDAwMDAwWjBHMQswCQYDVQQGEwJVUzEiMCAGA1UE
-ChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjQwdjAQBgcq
-hkjOPQIBBgUrgQQAIgNiAATzdHOnaItgrkO4NcWBMHtLSZ37wWHO5t5GvWvVYRg1rkDdc/eJkTBa
-6zzuhXyiQHY7qca4R9gq55KRanPpsXI5nymfopjTX15YhmUPoYRlBtHci8nHc8iMai/lxKvRHYqj
-QjBAMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBSATNbrdP9JNqPV
-2Py1PsVq8JQdjDAKBggqhkjOPQQDAwNnADBkAjBqUFJ0CMRw3J5QdCHojXohw0+WbhXRIjVhLfoI
-N+4Zba3bssx9BzT1YBkstTTZbyACMANxsbqjYAuG7ZoIapVon+Kz4ZNkfF6Tpt95LY2F45TPI11x
-zPKwTdb+mciUqXWi4w==
------END CERTIFICATE-----
-
UCA Global G2 Root
==================
-----BEGIN CERTIFICATE-----
@@ -3152,3 +2708,827 @@ WWRrJ8/vJ8HjJLWG965+Mk2weWjROeiQWMODvA8s1pfrzgzhIMfatz7DP78v3DSk+yshzWePS/Tj
OPQD8rv7gmsHINFSH5pkAnuYZttcTVoP0ISVoDwUQwbKytu4QTbaakRnh6+v40URFWkIsr4WOZck
bxJF0WddCajJFdr60qZfE2Efv4WstK2tBZQIgx51F9NxO5NQI1mg7TyRVJ12AMXDuDjb
-----END CERTIFICATE-----
+
+TunTrust Root CA
+================
+-----BEGIN CERTIFICATE-----
+MIIFszCCA5ugAwIBAgIUEwLV4kBMkkaGFmddtLu7sms+/BMwDQYJKoZIhvcNAQELBQAwYTELMAkG
+A1UEBhMCVE4xNzA1BgNVBAoMLkFnZW5jZSBOYXRpb25hbGUgZGUgQ2VydGlmaWNhdGlvbiBFbGVj
+dHJvbmlxdWUxGTAXBgNVBAMMEFR1blRydXN0IFJvb3QgQ0EwHhcNMTkwNDI2MDg1NzU2WhcNNDQw
+NDI2MDg1NzU2WjBhMQswCQYDVQQGEwJUTjE3MDUGA1UECgwuQWdlbmNlIE5hdGlvbmFsZSBkZSBD
+ZXJ0aWZpY2F0aW9uIEVsZWN0cm9uaXF1ZTEZMBcGA1UEAwwQVHVuVHJ1c3QgUm9vdCBDQTCCAiIw
+DQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAMPN0/y9BFPdDCA61YguBUtB9YOCfvdZn56eY+hz
+2vYGqU8ftPkLHzmMmiDQfgbU7DTZhrx1W4eI8NLZ1KMKsmwb60ksPqxd2JQDoOw05TDENX37Jk0b
+bjBU2PWARZw5rZzJJQRNmpA+TkBuimvNKWfGzC3gdOgFVwpIUPp6Q9p+7FuaDmJ2/uqdHYVy7BG7
+NegfJ7/Boce7SBbdVtfMTqDhuazb1YMZGoXRlJfXyqNlC/M4+QKu3fZnz8k/9YosRxqZbwUN/dAd
+gjH8KcwAWJeRTIAAHDOFli/LQcKLEITDCSSJH7UP2dl3RxiSlGBcx5kDPP73lad9UKGAwqmDrViW
+VSHbhlnUr8a83YFuB9tgYv7sEG7aaAH0gxupPqJbI9dkxt/con3YS7qC0lH4Zr8GRuR5KiY2eY8f
+Tpkdso8MDhz/yV3A/ZAQprE38806JG60hZC/gLkMjNWb1sjxVj8agIl6qeIbMlEsPvLfe/ZdeikZ
+juXIvTZxi11Mwh0/rViizz1wTaZQmCXcI/m4WEEIcb9PuISgjwBUFfyRbVinljvrS5YnzWuioYas
+DXxU5mZMZl+QviGaAkYt5IPCgLnPSz7ofzwB7I9ezX/SKEIBlYrilz0QIX32nRzFNKHsLA4KUiwS
+VXAkPcvCFDVDXSdOvsC9qnyW5/yeYa1E0wCXAgMBAAGjYzBhMB0GA1UdDgQWBBQGmpsfU33x9aTI
+04Y+oXNZtPdEITAPBgNVHRMBAf8EBTADAQH/MB8GA1UdIwQYMBaAFAaamx9TffH1pMjThj6hc1m0
+90QhMA4GA1UdDwEB/wQEAwIBBjANBgkqhkiG9w0BAQsFAAOCAgEAqgVutt0Vyb+zxiD2BkewhpMl
+0425yAA/l/VSJ4hxyXT968pk21vvHl26v9Hr7lxpuhbI87mP0zYuQEkHDVneixCwSQXi/5E/S7fd
+Ao74gShczNxtr18UnH1YeA32gAm56Q6XKRm4t+v4FstVEuTGfbvE7Pi1HE4+Z7/FXxttbUcoqgRY
+YdZ2vyJ/0Adqp2RT8JeNnYA/u8EH22Wv5psymsNUk8QcCMNE+3tjEUPRahphanltkE8pjkcFwRJp
+adbGNjHh/PqAulxPxOu3Mqz4dWEX1xAZufHSCe96Qp1bWgvUxpVOKs7/B9dPfhgGiPEZtdmYu65x
+xBzndFlY7wyJz4sfdZMaBBSSSFCp61cpABbjNhzI+L/wM9VBD8TMPN3pM0MBkRArHtG5Xc0yGYuP
+jCB31yLEQtyEFpslbei0VXF/sHyz03FJuc9SpAQ/3D2gu68zngowYI7bnV2UqL1g52KAdoGDDIzM
+MEZJ4gzSqK/rYXHv5yJiqfdcZGyfFoxnNidF9Ql7v/YQCvGwjVRDjAS6oz/v4jXH+XTgbzRB0L9z
+ZVcg+ZtnemZoJE6AZb0QmQZZ8mWvuMZHu/2QeItBcy6vVR/cO5JyboTT0GFMDcx2V+IthSIVNg3r
+AZ3r2OvEhJn7wAzMMujjd9qDRIueVSjAi1jTkD5OGwDxFa2DK5o=
+-----END CERTIFICATE-----
+
+HARICA TLS RSA Root CA 2021
+===========================
+-----BEGIN CERTIFICATE-----
+MIIFpDCCA4ygAwIBAgIQOcqTHO9D88aOk8f0ZIk4fjANBgkqhkiG9w0BAQsFADBsMQswCQYDVQQG
+EwJHUjE3MDUGA1UECgwuSGVsbGVuaWMgQWNhZGVtaWMgYW5kIFJlc2VhcmNoIEluc3RpdHV0aW9u
+cyBDQTEkMCIGA1UEAwwbSEFSSUNBIFRMUyBSU0EgUm9vdCBDQSAyMDIxMB4XDTIxMDIxOTEwNTUz
+OFoXDTQ1MDIxMzEwNTUzN1owbDELMAkGA1UEBhMCR1IxNzA1BgNVBAoMLkhlbGxlbmljIEFjYWRl
+bWljIGFuZCBSZXNlYXJjaCBJbnN0aXR1dGlvbnMgQ0ExJDAiBgNVBAMMG0hBUklDQSBUTFMgUlNB
+IFJvb3QgQ0EgMjAyMTCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAIvC569lmwVnlskN
+JLnQDmT8zuIkGCyEf3dRywQRNrhe7Wlxp57kJQmXZ8FHws+RFjZiPTgE4VGC/6zStGndLuwRo0Xu
+a2s7TL+MjaQenRG56Tj5eg4MmOIjHdFOY9TnuEFE+2uva9of08WRiFukiZLRgeaMOVig1mlDqa2Y
+Ulhu2wr7a89o+uOkXjpFc5gH6l8Cct4MpbOfrqkdtx2z/IpZ525yZa31MJQjB/OCFks1mJxTuy/K
+5FrZx40d/JiZ+yykgmvwKh+OC19xXFyuQnspiYHLA6OZyoieC0AJQTPb5lh6/a6ZcMBaD9YThnEv
+dmn8kN3bLW7R8pv1GmuebxWMevBLKKAiOIAkbDakO/IwkfN4E8/BPzWr8R0RI7VDIp4BkrcYAuUR
+0YLbFQDMYTfBKnya4dC6s1BG7oKsnTH4+yPiAwBIcKMJJnkVU2DzOFytOOqBAGMUuTNe3QvboEUH
+GjMJ+E20pwKmafTCWQWIZYVWrkvL4N48fS0ayOn7H6NhStYqE613TBoYm5EPWNgGVMWX+Ko/IIqm
+haZ39qb8HOLubpQzKoNQhArlT4b4UEV4AIHrW2jjJo3Me1xR9BQsQL4aYB16cmEdH2MtiKrOokWQ
+CPxrvrNQKlr9qEgYRtaQQJKQCoReaDH46+0N0x3GfZkYVVYnZS6NRcUk7M7jAgMBAAGjQjBAMA8G
+A1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFApII6ZgpJIKM+qTW8VX6iVNvRLuMA4GA1UdDwEB/wQE
+AwIBhjANBgkqhkiG9w0BAQsFAAOCAgEAPpBIqm5iFSVmewzVjIuJndftTgfvnNAUX15QvWiWkKQU
+EapobQk1OUAJ2vQJLDSle1mESSmXdMgHHkdt8s4cUCbjnj1AUz/3f5Z2EMVGpdAgS1D0NTsY9FVq
+QRtHBmg8uwkIYtlfVUKqrFOFrJVWNlar5AWMxajaH6NpvVMPxP/cyuN+8kyIhkdGGvMA9YCRotxD
+QpSbIPDRzbLrLFPCU3hKTwSUQZqPJzLB5UkZv/HywouoCjkxKLR9YjYsTewfM7Z+d21+UPCfDtcR
+j88YxeMn/ibvBZ3PzzfF0HvaO7AWhAw6k9a+F9sPPg4ZeAnHqQJyIkv3N3a6dcSFA1pj1bF1BcK5
+vZStjBWZp5N99sXzqnTPBIWUmAD04vnKJGW/4GKvyMX6ssmeVkjaef2WdhW+o45WxLM0/L5H9MG0
+qPzVMIho7suuyWPEdr6sOBjhXlzPrjoiUevRi7PzKzMHVIf6tLITe7pTBGIBnfHAT+7hOtSLIBD6
+Alfm78ELt5BGnBkpjNxvoEppaZS3JGWg/6w/zgH7IS79aPib8qXPMThcFarmlwDB31qlpzmq6YR/
+PFGoOtmUW4y/Twhx5duoXNTSpv4Ao8YWxw/ogM4cKGR0GQjTQuPOAF1/sdwTsOEFy9EgqoZ0njnn
+kf3/W9b3raYvAwtt41dU63ZTGI0RmLo=
+-----END CERTIFICATE-----
+
+HARICA TLS ECC Root CA 2021
+===========================
+-----BEGIN CERTIFICATE-----
+MIICVDCCAdugAwIBAgIQZ3SdjXfYO2rbIvT/WeK/zjAKBggqhkjOPQQDAzBsMQswCQYDVQQGEwJH
+UjE3MDUGA1UECgwuSGVsbGVuaWMgQWNhZGVtaWMgYW5kIFJlc2VhcmNoIEluc3RpdHV0aW9ucyBD
+QTEkMCIGA1UEAwwbSEFSSUNBIFRMUyBFQ0MgUm9vdCBDQSAyMDIxMB4XDTIxMDIxOTExMDExMFoX
+DTQ1MDIxMzExMDEwOVowbDELMAkGA1UEBhMCR1IxNzA1BgNVBAoMLkhlbGxlbmljIEFjYWRlbWlj
+IGFuZCBSZXNlYXJjaCBJbnN0aXR1dGlvbnMgQ0ExJDAiBgNVBAMMG0hBUklDQSBUTFMgRUNDIFJv
+b3QgQ0EgMjAyMTB2MBAGByqGSM49AgEGBSuBBAAiA2IABDgI/rGgltJ6rK9JOtDA4MM7KKrxcm1l
+AEeIhPyaJmuqS7psBAqIXhfyVYf8MLA04jRYVxqEU+kw2anylnTDUR9YSTHMmE5gEYd103KUkE+b
+ECUqqHgtvpBBWJAVcqeht6NCMEAwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQUyRtTgRL+BNUW
+0aq8mm+3oJUZbsowDgYDVR0PAQH/BAQDAgGGMAoGCCqGSM49BAMDA2cAMGQCMBHervjcToiwqfAi
+rcJRQO9gcS3ujwLEXQNwSaSS6sUUiHCm0w2wqsosQJz76YJumgIwK0eaB8bRwoF8yguWGEEbo/Qw
+CZ61IygNnxS2PFOiTAZpffpskcYqSUXm7LcT4Tps
+-----END CERTIFICATE-----
+
+Autoridad de Certificacion Firmaprofesional CIF A62634068
+=========================================================
+-----BEGIN CERTIFICATE-----
+MIIGFDCCA/ygAwIBAgIIG3Dp0v+ubHEwDQYJKoZIhvcNAQELBQAwUTELMAkGA1UEBhMCRVMxQjBA
+BgNVBAMMOUF1dG9yaWRhZCBkZSBDZXJ0aWZpY2FjaW9uIEZpcm1hcHJvZmVzaW9uYWwgQ0lGIEE2
+MjYzNDA2ODAeFw0xNDA5MjMxNTIyMDdaFw0zNjA1MDUxNTIyMDdaMFExCzAJBgNVBAYTAkVTMUIw
+QAYDVQQDDDlBdXRvcmlkYWQgZGUgQ2VydGlmaWNhY2lvbiBGaXJtYXByb2Zlc2lvbmFsIENJRiBB
+NjI2MzQwNjgwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDKlmuO6vj78aI14H9M2uDD
+Utd9thDIAl6zQyrET2qyyhxdKJp4ERppWVevtSBC5IsP5t9bpgOSL/UR5GLXMnE42QQMcas9UX4P
+B99jBVzpv5RvwSmCwLTaUbDBPLutN0pcyvFLNg4kq7/DhHf9qFD0sefGL9ItWY16Ck6WaVICqjaY
+7Pz6FIMMNx/Jkjd/14Et5cS54D40/mf0PmbR0/RAz15iNA9wBj4gGFrO93IbJWyTdBSTo3OxDqqH
+ECNZXyAFGUftaI6SEspd/NYrspI8IM/hX68gvqB2f3bl7BqGYTM+53u0P6APjqK5am+5hyZvQWyI
+plD9amML9ZMWGxmPsu2bm8mQ9QEM3xk9Dz44I8kvjwzRAv4bVdZO0I08r0+k8/6vKtMFnXkIoctX
+MbScyJCyZ/QYFpM6/EfY0XiWMR+6KwxfXZmtY4laJCB22N/9q06mIqqdXuYnin1oKaPnirjaEbsX
+LZmdEyRG98Xi2J+Of8ePdG1asuhy9azuJBCtLxTa/y2aRnFHvkLfuwHb9H/TKI8xWVvTyQKmtFLK
+bpf7Q8UIJm+K9Lv9nyiqDdVF8xM6HdjAeI9BZzwelGSuewvF6NkBiDkal4ZkQdU7hwxu+g/GvUgU
+vzlN1J5Bto+WHWOWk9mVBngxaJ43BjuAiUVhOSPHG0SjFeUc+JIwuwIDAQABo4HvMIHsMB0GA1Ud
+DgQWBBRlzeurNR4APn7VdMActHNHDhpkLzASBgNVHRMBAf8ECDAGAQH/AgEBMIGmBgNVHSAEgZ4w
+gZswgZgGBFUdIAAwgY8wLwYIKwYBBQUHAgEWI2h0dHA6Ly93d3cuZmlybWFwcm9mZXNpb25hbC5j
+b20vY3BzMFwGCCsGAQUFBwICMFAeTgBQAGEAcwBlAG8AIABkAGUAIABsAGEAIABCAG8AbgBhAG4A
+bwB2AGEAIAA0ADcAIABCAGEAcgBjAGUAbABvAG4AYQAgADAAOAAwADEANzAOBgNVHQ8BAf8EBAMC
+AQYwDQYJKoZIhvcNAQELBQADggIBAHSHKAIrdx9miWTtj3QuRhy7qPj4Cx2Dtjqn6EWKB7fgPiDL
+4QjbEwj4KKE1soCzC1HA01aajTNFSa9J8OA9B3pFE1r/yJfY0xgsfZb43aJlQ3CTkBW6kN/oGbDb
+LIpgD7dvlAceHabJhfa9NPhAeGIQcDq+fUs5gakQ1JZBu/hfHAsdCPKxsIl68veg4MSPi3i1O1il
+I45PVf42O+AMt8oqMEEgtIDNrvx2ZnOorm7hfNoD6JQg5iKj0B+QXSBTFCZX2lSX3xZEEAEeiGaP
+cjiT3SC3NL7X8e5jjkd5KAb881lFJWAiMxujX6i6KtoaPc1A6ozuBRWV1aUsIC+nmCjuRfzxuIgA
+LI9C2lHVnOUTaHFFQ4ueCyE8S1wF3BqfmI7avSKecs2tCsvMo2ebKHTEm9caPARYpoKdrcd7b/+A
+lun4jWq9GJAd/0kakFI3ky88Al2CdgtR5xbHV/g4+afNmyJU72OwFW1TZQNKXkqgsqeOSQBZONXH
+9IBk9W6VULgRfhVwOEqwf9DEMnDAGf/JOC0ULGb0QkTmVXYbgBVX/8Cnp6o5qtjTcNAuuuuUavpf
+NIbnYrX9ivAwhZTJryQCL2/W3Wf+47BVTwSYT6RBVuKT0Gro1vP7ZeDOdcQxWQzugsgMYDNKGbqE
+ZycPvEJdvSRUDewdcAZfpLz6IHxV
+-----END CERTIFICATE-----
+
+vTrus ECC Root CA
+=================
+-----BEGIN CERTIFICATE-----
+MIICDzCCAZWgAwIBAgIUbmq8WapTvpg5Z6LSa6Q75m0c1towCgYIKoZIzj0EAwMwRzELMAkGA1UE
+BhMCQ04xHDAaBgNVBAoTE2lUcnVzQ2hpbmEgQ28uLEx0ZC4xGjAYBgNVBAMTEXZUcnVzIEVDQyBS
+b290IENBMB4XDTE4MDczMTA3MjY0NFoXDTQzMDczMTA3MjY0NFowRzELMAkGA1UEBhMCQ04xHDAa
+BgNVBAoTE2lUcnVzQ2hpbmEgQ28uLEx0ZC4xGjAYBgNVBAMTEXZUcnVzIEVDQyBSb290IENBMHYw
+EAYHKoZIzj0CAQYFK4EEACIDYgAEZVBKrox5lkqqHAjDo6LN/llWQXf9JpRCux3NCNtzslt188+c
+ToL0v/hhJoVs1oVbcnDS/dtitN9Ti72xRFhiQgnH+n9bEOf+QP3A2MMrMudwpremIFUde4BdS49n
+TPEQo0IwQDAdBgNVHQ4EFgQUmDnNvtiyjPeyq+GtJK97fKHbH88wDwYDVR0TAQH/BAUwAwEB/zAO
+BgNVHQ8BAf8EBAMCAQYwCgYIKoZIzj0EAwMDaAAwZQIwV53dVvHH4+m4SVBrm2nDb+zDfSXkV5UT
+QJtS0zvzQBm8JsctBp61ezaf9SXUY2sAAjEA6dPGnlaaKsyh2j/IZivTWJwghfqrkYpwcBE4YGQL
+YgmRWAD5Tfs0aNoJrSEGGJTO
+-----END CERTIFICATE-----
+
+vTrus Root CA
+=============
+-----BEGIN CERTIFICATE-----
+MIIFVjCCAz6gAwIBAgIUQ+NxE9izWRRdt86M/TX9b7wFjUUwDQYJKoZIhvcNAQELBQAwQzELMAkG
+A1UEBhMCQ04xHDAaBgNVBAoTE2lUcnVzQ2hpbmEgQ28uLEx0ZC4xFjAUBgNVBAMTDXZUcnVzIFJv
+b3QgQ0EwHhcNMTgwNzMxMDcyNDA1WhcNNDMwNzMxMDcyNDA1WjBDMQswCQYDVQQGEwJDTjEcMBoG
+A1UEChMTaVRydXNDaGluYSBDby4sTHRkLjEWMBQGA1UEAxMNdlRydXMgUm9vdCBDQTCCAiIwDQYJ
+KoZIhvcNAQEBBQADggIPADCCAgoCggIBAL1VfGHTuB0EYgWgrmy3cLRB6ksDXhA/kFocizuwZots
+SKYcIrrVQJLuM7IjWcmOvFjai57QGfIvWcaMY1q6n6MLsLOaXLoRuBLpDLvPbmyAhykUAyyNJJrI
+ZIO1aqwTLDPxn9wsYTwaP3BVm60AUn/PBLn+NvqcwBauYv6WTEN+VRS+GrPSbcKvdmaVayqwlHeF
+XgQPYh1jdfdr58tbmnDsPmcF8P4HCIDPKNsFxhQnL4Z98Cfe/+Z+M0jnCx5Y0ScrUw5XSmXX+6KA
+YPxMvDVTAWqXcoKv8R1w6Jz1717CbMdHflqUhSZNO7rrTOiwCcJlwp2dCZtOtZcFrPUGoPc2BX70
+kLJrxLT5ZOrpGgrIDajtJ8nU57O5q4IikCc9Kuh8kO+8T/3iCiSn3mUkpF3qwHYw03dQ+A0Em5Q2
+AXPKBlim0zvc+gRGE1WKyURHuFE5Gi7oNOJ5y1lKCn+8pu8fA2dqWSslYpPZUxlmPCdiKYZNpGvu
+/9ROutW04o5IWgAZCfEF2c6Rsffr6TlP9m8EQ5pV9T4FFL2/s1m02I4zhKOQUqqzApVg+QxMaPnu
+1RcN+HFXtSXkKe5lXa/R7jwXC1pDxaWG6iSe4gUH3DRCEpHWOXSuTEGC2/KmSNGzm/MzqvOmwMVO
+9fSddmPmAsYiS8GVP1BkLFTltvA8Kc9XAgMBAAGjQjBAMB0GA1UdDgQWBBRUYnBj8XWEQ1iO0RYg
+scasGrz2iTAPBgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBBjANBgkqhkiG9w0BAQsFAAOC
+AgEAKbqSSaet8PFww+SX8J+pJdVrnjT+5hpk9jprUrIQeBqfTNqK2uwcN1LgQkv7bHbKJAs5EhWd
+nxEt/Hlk3ODg9d3gV8mlsnZwUKT+twpw1aA08XXXTUm6EdGz2OyC/+sOxL9kLX1jbhd47F18iMjr
+jld22VkE+rxSH0Ws8HqA7Oxvdq6R2xCOBNyS36D25q5J08FsEhvMKar5CKXiNxTKsbhm7xqC5PD4
+8acWabfbqWE8n/Uxy+QARsIvdLGx14HuqCaVvIivTDUHKgLKeBRtRytAVunLKmChZwOgzoy8sHJn
+xDHO2zTlJQNgJXtxmOTAGytfdELSS8VZCAeHvsXDf+eW2eHcKJfWjwXj9ZtOyh1QRwVTsMo554Wg
+icEFOwE30z9J4nfrI8iIZjs9OXYhRvHsXyO466JmdXTBQPfYaJqT4i2pLr0cox7IdMakLXogqzu4
+sEb9b91fUlV1YvCXoHzXOP0l382gmxDPi7g4Xl7FtKYCNqEeXxzP4padKar9mK5S4fNBUvupLnKW
+nyfjqnN9+BojZns7q2WwMgFLFT49ok8MKzWixtlnEjUwzXYuFrOZnk1PTi07NEPhmg4NpGaXutIc
+SkwsKouLgU9xGqndXHt7CMUADTdA43x7VF8vhV929vensBxXVsFy6K2ir40zSbofitzmdHxghm+H
+l3s=
+-----END CERTIFICATE-----
+
+ISRG Root X2
+============
+-----BEGIN CERTIFICATE-----
+MIICGzCCAaGgAwIBAgIQQdKd0XLq7qeAwSxs6S+HUjAKBggqhkjOPQQDAzBPMQswCQYDVQQGEwJV
+UzEpMCcGA1UEChMgSW50ZXJuZXQgU2VjdXJpdHkgUmVzZWFyY2ggR3JvdXAxFTATBgNVBAMTDElT
+UkcgUm9vdCBYMjAeFw0yMDA5MDQwMDAwMDBaFw00MDA5MTcxNjAwMDBaME8xCzAJBgNVBAYTAlVT
+MSkwJwYDVQQKEyBJbnRlcm5ldCBTZWN1cml0eSBSZXNlYXJjaCBHcm91cDEVMBMGA1UEAxMMSVNS
+RyBSb290IFgyMHYwEAYHKoZIzj0CAQYFK4EEACIDYgAEzZvVn4CDCuwJSvMWSj5cz3es3mcFDR0H
+ttwW+1qLFNvicWDEukWVEYmO6gbf9yoWHKS5xcUy4APgHoIYOIvXRdgKam7mAHf7AlF9ItgKbppb
+d9/w+kHsOdx1ymgHDB/qo0IwQDAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAdBgNV
+HQ4EFgQUfEKWrt5LSDv6kviejM9ti6lyN5UwCgYIKoZIzj0EAwMDaAAwZQIwe3lORlCEwkSHRhtF
+cP9Ymd70/aTSVaYgLXTWNLxBo1BfASdWtL4ndQavEi51mI38AjEAi/V3bNTIZargCyzuFJ0nN6T5
+U6VR5CmD1/iQMVtCnwr1/q4AaOeMSQ+2b1tbFfLn
+-----END CERTIFICATE-----
+
+HiPKI Root CA - G1
+==================
+-----BEGIN CERTIFICATE-----
+MIIFajCCA1KgAwIBAgIQLd2szmKXlKFD6LDNdmpeYDANBgkqhkiG9w0BAQsFADBPMQswCQYDVQQG
+EwJUVzEjMCEGA1UECgwaQ2h1bmdod2EgVGVsZWNvbSBDby4sIEx0ZC4xGzAZBgNVBAMMEkhpUEtJ
+IFJvb3QgQ0EgLSBHMTAeFw0xOTAyMjIwOTQ2MDRaFw0zNzEyMzExNTU5NTlaME8xCzAJBgNVBAYT
+AlRXMSMwIQYDVQQKDBpDaHVuZ2h3YSBUZWxlY29tIENvLiwgTHRkLjEbMBkGA1UEAwwSSGlQS0kg
+Um9vdCBDQSAtIEcxMIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEA9B5/UnMyDHPkvRN0
+o9QwqNCuS9i233VHZvR85zkEHmpwINJaR3JnVfSl6J3VHiGh8Ge6zCFovkRTv4354twvVcg3Px+k
+wJyz5HdcoEb+d/oaoDjq7Zpy3iu9lFc6uux55199QmQ5eiY29yTw1S+6lZgRZq2XNdZ1AYDgr/SE
+YYwNHl98h5ZeQa/rh+r4XfEuiAU+TCK72h8q3VJGZDnzQs7ZngyzsHeXZJzA9KMuH5UHsBffMNsA
+GJZMoYFL3QRtU6M9/Aes1MU3guvklQgZKILSQjqj2FPseYlgSGDIcpJQ3AOPgz+yQlda22rpEZfd
+hSi8MEyr48KxRURHH+CKFgeW0iEPU8DtqX7UTuybCeyvQqww1r/REEXgphaypcXTT3OUM3ECoWqj
+1jOXTyFjHluP2cFeRXF3D4FdXyGarYPM+l7WjSNfGz1BryB1ZlpK9p/7qxj3ccC2HTHsOyDry+K4
+9a6SsvfhhEvyovKTmiKe0xRvNlS9H15ZFblzqMF8b3ti6RZsR1pl8w4Rm0bZ/W3c1pzAtH2lsN0/
+Vm+h+fbkEkj9Bn8SV7apI09bA8PgcSojt/ewsTu8mL3WmKgMa/aOEmem8rJY5AIJEzypuxC00jBF
+8ez3ABHfZfjcK0NVvxaXxA/VLGGEqnKG/uY6fsI/fe78LxQ+5oXdUG+3Se0CAwEAAaNCMEAwDwYD
+VR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQU8ncX+l6o/vY9cdVouslGDDjYr7AwDgYDVR0PAQH/BAQD
+AgGGMA0GCSqGSIb3DQEBCwUAA4ICAQBQUfB13HAE4/+qddRxosuej6ip0691x1TPOhwEmSKsxBHi
+7zNKpiMdDg1H2DfHb680f0+BazVP6XKlMeJ45/dOlBhbQH3PayFUhuaVevvGyuqcSE5XCV0vrPSl
+tJczWNWseanMX/mF+lLFjfiRFOs6DRfQUsJ748JzjkZ4Bjgs6FzaZsT0pPBWGTMpWmWSBUdGSquE
+wx4noR8RkpkndZMPvDY7l1ePJlsMu5wP1G4wB9TcXzZoZjmDlicmisjEOf6aIW/Vcobpf2Lll07Q
+JNBAsNB1CI69aO4I1258EHBGG3zgiLKecoaZAeO/n0kZtCW+VmWuF2PlHt/o/0elv+EmBYTksMCv
+5wiZqAxeJoBF1PhoL5aPruJKHJwWDBNvOIf2u8g0X5IDUXlwpt/L9ZlNec1OvFefQ05rLisY+Gpz
+jLrFNe85akEez3GoorKGB1s6yeHvP2UEgEcyRHCVTjFnanRbEEV16rCf0OY1/k6fi8wrkkVbbiVg
+hUbN0aqwdmaTd5a+g744tiROJgvM7XpWGuDpWsZkrUx6AEhEL7lAuxM+vhV4nYWBSipX3tUZQ9rb
+yltHhoMLP7YNdnhzeSJesYAfz77RP1YQmCuVh6EfnWQUYDksswBVLuT1sw5XxJFBAJw/6KXf6vb/
+yPCtbVKoF6ubYfwSUTXkJf2vqmqGOQ==
+-----END CERTIFICATE-----
+
+GlobalSign ECC Root CA - R4
+===========================
+-----BEGIN CERTIFICATE-----
+MIIB3DCCAYOgAwIBAgINAgPlfvU/k/2lCSGypjAKBggqhkjOPQQDAjBQMSQwIgYDVQQLExtHbG9i
+YWxTaWduIEVDQyBSb290IENBIC0gUjQxEzARBgNVBAoTCkdsb2JhbFNpZ24xEzARBgNVBAMTCkds
+b2JhbFNpZ24wHhcNMTIxMTEzMDAwMDAwWhcNMzgwMTE5MDMxNDA3WjBQMSQwIgYDVQQLExtHbG9i
+YWxTaWduIEVDQyBSb290IENBIC0gUjQxEzARBgNVBAoTCkdsb2JhbFNpZ24xEzARBgNVBAMTCkds
+b2JhbFNpZ24wWTATBgcqhkjOPQIBBggqhkjOPQMBBwNCAAS4xnnTj2wlDp8uORkcA6SumuU5BwkW
+ymOxuYb4ilfBV85C+nOh92VC/x7BALJucw7/xyHlGKSq2XE/qNS5zowdo0IwQDAOBgNVHQ8BAf8E
+BAMCAYYwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQUVLB7rUW44kB/+wpu+74zyTyjhNUwCgYI
+KoZIzj0EAwIDRwAwRAIgIk90crlgr/HmnKAWBVBfw147bmF0774BxL4YSFlhgjICICadVGNA3jdg
+UM/I2O2dgq43mLyjj0xMqTQrbO/7lZsm
+-----END CERTIFICATE-----
+
+GTS Root R1
+===========
+-----BEGIN CERTIFICATE-----
+MIIFVzCCAz+gAwIBAgINAgPlk28xsBNJiGuiFzANBgkqhkiG9w0BAQwFADBHMQswCQYDVQQGEwJV
+UzEiMCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3Qg
+UjEwHhcNMTYwNjIyMDAwMDAwWhcNMzYwNjIyMDAwMDAwWjBHMQswCQYDVQQGEwJVUzEiMCAGA1UE
+ChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjEwggIiMA0G
+CSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQC2EQKLHuOhd5s73L+UPreVp0A8of2C+X0yBoJx9vaM
+f/vo27xqLpeXo4xL+Sv2sfnOhB2x+cWX3u+58qPpvBKJXqeqUqv4IyfLpLGcY9vXmX7wCl7raKb0
+xlpHDU0QM+NOsROjyBhsS+z8CZDfnWQpJSMHobTSPS5g4M/SCYe7zUjwTcLCeoiKu7rPWRnWr4+w
+B7CeMfGCwcDfLqZtbBkOtdh+JhpFAz2weaSUKK0PfyblqAj+lug8aJRT7oM6iCsVlgmy4HqMLnXW
+nOunVmSPlk9orj2XwoSPwLxAwAtcvfaHszVsrBhQf4TgTM2S0yDpM7xSma8ytSmzJSq0SPly4cpk
+9+aCEI3oncKKiPo4Zor8Y/kB+Xj9e1x3+naH+uzfsQ55lVe0vSbv1gHR6xYKu44LtcXFilWr06zq
+kUspzBmkMiVOKvFlRNACzqrOSbTqn3yDsEB750Orp2yjj32JgfpMpf/VjsPOS+C12LOORc92wO1A
+K/1TD7Cn1TsNsYqiA94xrcx36m97PtbfkSIS5r762DL8EGMUUXLeXdYWk70paDPvOmbsB4om3xPX
+V2V4J95eSRQAogB/mqghtqmxlbCluQ0WEdrHbEg8QOB+DVrNVjzRlwW5y0vtOUucxD/SVRNuJLDW
+cfr0wbrM7Rv1/oFB2ACYPTrIrnqYNxgFlQIDAQABo0IwQDAOBgNVHQ8BAf8EBAMCAYYwDwYDVR0T
+AQH/BAUwAwEB/zAdBgNVHQ4EFgQU5K8rJnEaK0gnhS9SZizv8IkTcT4wDQYJKoZIhvcNAQEMBQAD
+ggIBAJ+qQibbC5u+/x6Wki4+omVKapi6Ist9wTrYggoGxval3sBOh2Z5ofmmWJyq+bXmYOfg6LEe
+QkEzCzc9zolwFcq1JKjPa7XSQCGYzyI0zzvFIoTgxQ6KfF2I5DUkzps+GlQebtuyh6f88/qBVRRi
+ClmpIgUxPoLW7ttXNLwzldMXG+gnoot7TiYaelpkttGsN/H9oPM47HLwEXWdyzRSjeZ2axfG34ar
+J45JK3VmgRAhpuo+9K4l/3wV3s6MJT/KYnAK9y8JZgfIPxz88NtFMN9iiMG1D53Dn0reWVlHxYci
+NuaCp+0KueIHoI17eko8cdLiA6EfMgfdG+RCzgwARWGAtQsgWSl4vflVy2PFPEz0tv/bal8xa5me
+LMFrUKTX5hgUvYU/Z6tGn6D/Qqc6f1zLXbBwHSs09dR2CQzreExZBfMzQsNhFRAbd03OIozUhfJF
+fbdT6u9AWpQKXCBfTkBdYiJ23//OYb2MI3jSNwLgjt7RETeJ9r/tSQdirpLsQBqvFAnZ0E6yove+
+7u7Y/9waLd64NnHi/Hm3lCXRSHNboTXns5lndcEZOitHTtNCjv0xyBZm2tIMPNuzjsmhDYAPexZ3
+FL//2wmUspO8IFgV6dtxQ/PeEMMA3KgqlbbC1j+Qa3bbbP6MvPJwNQzcmRk13NfIRmPVNnGuV/u3
+gm3c
+-----END CERTIFICATE-----
+
+GTS Root R2
+===========
+-----BEGIN CERTIFICATE-----
+MIIFVzCCAz+gAwIBAgINAgPlrsWNBCUaqxElqjANBgkqhkiG9w0BAQwFADBHMQswCQYDVQQGEwJV
+UzEiMCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3Qg
+UjIwHhcNMTYwNjIyMDAwMDAwWhcNMzYwNjIyMDAwMDAwWjBHMQswCQYDVQQGEwJVUzEiMCAGA1UE
+ChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjIwggIiMA0G
+CSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDO3v2m++zsFDQ8BwZabFn3GTXd98GdVarTzTukk3Lv
+CvptnfbwhYBboUhSnznFt+4orO/LdmgUud+tAWyZH8QiHZ/+cnfgLFuv5AS/T3KgGjSY6Dlo7JUl
+e3ah5mm5hRm9iYz+re026nO8/4Piy33B0s5Ks40FnotJk9/BW9BuXvAuMC6C/Pq8tBcKSOWIm8Wb
+a96wyrQD8Nr0kLhlZPdcTK3ofmZemde4wj7I0BOdre7kRXuJVfeKH2JShBKzwkCX44ofR5GmdFrS
++LFjKBC4swm4VndAoiaYecb+3yXuPuWgf9RhD1FLPD+M2uFwdNjCaKH5wQzpoeJ/u1U8dgbuak7M
+kogwTZq9TwtImoS1mKPV+3PBV2HdKFZ1E66HjucMUQkQdYhMvI35ezzUIkgfKtzra7tEscszcTJG
+r61K8YzodDqs5xoic4DSMPclQsciOzsSrZYuxsN2B6ogtzVJV+mSSeh2FnIxZyuWfoqjx5RWIr9q
+S34BIbIjMt/kmkRtWVtd9QCgHJvGeJeNkP+byKq0rxFROV7Z+2et1VsRnTKaG73VululycslaVNV
+J1zgyjbLiGH7HrfQy+4W+9OmTN6SpdTi3/UGVN4unUu0kzCqgc7dGtxRcw1PcOnlthYhGXmy5okL
+dWTK1au8CcEYof/UVKGFPP0UJAOyh9OktwIDAQABo0IwQDAOBgNVHQ8BAf8EBAMCAYYwDwYDVR0T
+AQH/BAUwAwEB/zAdBgNVHQ4EFgQUu//KjiOfT5nK2+JopqUVJxce2Q4wDQYJKoZIhvcNAQEMBQAD
+ggIBAB/Kzt3HvqGf2SdMC9wXmBFqiN495nFWcrKeGk6c1SuYJF2ba3uwM4IJvd8lRuqYnrYb/oM8
+0mJhwQTtzuDFycgTE1XnqGOtjHsB/ncw4c5omwX4Eu55MaBBRTUoCnGkJE+M3DyCB19m3H0Q/gxh
+swWV7uGugQ+o+MePTagjAiZrHYNSVc61LwDKgEDg4XSsYPWHgJ2uNmSRXbBoGOqKYcl3qJfEycel
+/FVL8/B/uWU9J2jQzGv6U53hkRrJXRqWbTKH7QMgyALOWr7Z6v2yTcQvG99fevX4i8buMTolUVVn
+jWQye+mew4K6Ki3pHrTgSAai/GevHyICc/sgCq+dVEuhzf9gR7A/Xe8bVr2XIZYtCtFenTgCR2y5
+9PYjJbigapordwj6xLEokCZYCDzifqrXPW+6MYgKBesntaFJ7qBFVHvmJ2WZICGoo7z7GJa7Um8M
+7YNRTOlZ4iBgxcJlkoKM8xAfDoqXvneCbT+PHV28SSe9zE8P4c52hgQjxcCMElv924SgJPFI/2R8
+0L5cFtHvma3AH/vLrrw4IgYmZNralw4/KBVEqE8AyvCazM90arQ+POuV7LXTWtiBmelDGDfrs7vR
+WGJB82bSj6p4lVQgw1oudCvV0b4YacCs1aTPObpRhANl6WLAYv7YTVWW4tAR+kg0Eeye7QUd5MjW
+HYbL
+-----END CERTIFICATE-----
+
+GTS Root R3
+===========
+-----BEGIN CERTIFICATE-----
+MIICCTCCAY6gAwIBAgINAgPluILrIPglJ209ZjAKBggqhkjOPQQDAzBHMQswCQYDVQQGEwJVUzEi
+MCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjMw
+HhcNMTYwNjIyMDAwMDAwWhcNMzYwNjIyMDAwMDAwWjBHMQswCQYDVQQGEwJVUzEiMCAGA1UEChMZ
+R29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjMwdjAQBgcqhkjO
+PQIBBgUrgQQAIgNiAAQfTzOHMymKoYTey8chWEGJ6ladK0uFxh1MJ7x/JlFyb+Kf1qPKzEUURout
+736GjOyxfi//qXGdGIRFBEFVbivqJn+7kAHjSxm65FSWRQmx1WyRRK2EE46ajA2ADDL24CejQjBA
+MA4GA1UdDwEB/wQEAwIBhjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBTB8Sa6oC2uhYHP0/Eq
+Er24Cmf9vDAKBggqhkjOPQQDAwNpADBmAjEA9uEglRR7VKOQFhG/hMjqb2sXnh5GmCCbn9MN2azT
+L818+FsuVbu/3ZL3pAzcMeGiAjEA/JdmZuVDFhOD3cffL74UOO0BzrEXGhF16b0DjyZ+hOXJYKaV
+11RZt+cRLInUue4X
+-----END CERTIFICATE-----
+
+GTS Root R4
+===========
+-----BEGIN CERTIFICATE-----
+MIICCTCCAY6gAwIBAgINAgPlwGjvYxqccpBQUjAKBggqhkjOPQQDAzBHMQswCQYDVQQGEwJVUzEi
+MCAGA1UEChMZR29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjQw
+HhcNMTYwNjIyMDAwMDAwWhcNMzYwNjIyMDAwMDAwWjBHMQswCQYDVQQGEwJVUzEiMCAGA1UEChMZ
+R29vZ2xlIFRydXN0IFNlcnZpY2VzIExMQzEUMBIGA1UEAxMLR1RTIFJvb3QgUjQwdjAQBgcqhkjO
+PQIBBgUrgQQAIgNiAATzdHOnaItgrkO4NcWBMHtLSZ37wWHO5t5GvWvVYRg1rkDdc/eJkTBa6zzu
+hXyiQHY7qca4R9gq55KRanPpsXI5nymfopjTX15YhmUPoYRlBtHci8nHc8iMai/lxKvRHYqjQjBA
+MA4GA1UdDwEB/wQEAwIBhjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBSATNbrdP9JNqPV2Py1
+PsVq8JQdjDAKBggqhkjOPQQDAwNpADBmAjEA6ED/g94D9J+uHXqnLrmvT/aDHQ4thQEd0dlq7A/C
+r8deVl5c1RxYIigL9zC2L7F8AjEA8GE8p/SgguMh1YQdc4acLa/KNJvxn7kjNuK8YAOdgLOaVsjh
+4rsUecrNIdSUtUlD
+-----END CERTIFICATE-----
+
+Telia Root CA v2
+================
+-----BEGIN CERTIFICATE-----
+MIIFdDCCA1ygAwIBAgIPAWdfJ9b+euPkrL4JWwWeMA0GCSqGSIb3DQEBCwUAMEQxCzAJBgNVBAYT
+AkZJMRowGAYDVQQKDBFUZWxpYSBGaW5sYW5kIE95ajEZMBcGA1UEAwwQVGVsaWEgUm9vdCBDQSB2
+MjAeFw0xODExMjkxMTU1NTRaFw00MzExMjkxMTU1NTRaMEQxCzAJBgNVBAYTAkZJMRowGAYDVQQK
+DBFUZWxpYSBGaW5sYW5kIE95ajEZMBcGA1UEAwwQVGVsaWEgUm9vdCBDQSB2MjCCAiIwDQYJKoZI
+hvcNAQEBBQADggIPADCCAgoCggIBALLQPwe84nvQa5n44ndp586dpAO8gm2h/oFlH0wnrI4AuhZ7
+6zBqAMCzdGh+sq/H1WKzej9Qyow2RCRj0jbpDIX2Q3bVTKFgcmfiKDOlyzG4OiIjNLh9vVYiQJ3q
+9HsDrWj8soFPmNB06o3lfc1jw6P23pLCWBnglrvFxKk9pXSW/q/5iaq9lRdU2HhE8Qx3FZLgmEKn
+pNaqIJLNwaCzlrI6hEKNfdWV5Nbb6WLEWLN5xYzTNTODn3WhUidhOPFZPY5Q4L15POdslv5e2QJl
+tI5c0BE0312/UqeBAMN/mUWZFdUXyApT7GPzmX3MaRKGwhfwAZ6/hLzRUssbkmbOpFPlob/E2wnW
+5olWK8jjfN7j/4nlNW4o6GwLI1GpJQXrSPjdscr6bAhR77cYbETKJuFzxokGgeWKrLDiKca5JLNr
+RBH0pUPCTEPlcDaMtjNXepUugqD0XBCzYYP2AgWGLnwtbNwDRm41k9V6lS/eINhbfpSQBGq6WT0E
+BXWdN6IOLj3rwaRSg/7Qa9RmjtzG6RJOHSpXqhC8fF6CfaamyfItufUXJ63RDolUK5X6wK0dmBR4
+M0KGCqlztft0DbcbMBnEWg4cJ7faGND/isgFuvGqHKI3t+ZIpEYslOqodmJHixBTB0hXbOKSTbau
+BcvcwUpej6w9GU7C7WB1K9vBykLVAgMBAAGjYzBhMB8GA1UdIwQYMBaAFHKs5DN5qkWH9v2sHZ7W
+xy+G2CQ5MB0GA1UdDgQWBBRyrOQzeapFh/b9rB2e1scvhtgkOTAOBgNVHQ8BAf8EBAMCAQYwDwYD
+VR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQsFAAOCAgEAoDtZpwmUPjaE0n4vOaWWl/oRrfxn83EJ
+8rKJhGdEr7nv7ZbsnGTbMjBvZ5qsfl+yqwE2foH65IRe0qw24GtixX1LDoJt0nZi0f6X+J8wfBj5
+tFJ3gh1229MdqfDBmgC9bXXYfef6xzijnHDoRnkDry5023X4blMMA8iZGok1GTzTyVR8qPAs5m4H
+eW9q4ebqkYJpCh3DflminmtGFZhb069GHWLIzoBSSRE/yQQSwxN8PzuKlts8oB4KtItUsiRnDe+C
+y748fdHif64W1lZYudogsYMVoe+KTTJvQS8TUoKU1xrBeKJR3Stwbbca+few4GeXVtt8YVMJAygC
+QMez2P2ccGrGKMOF6eLtGpOg3kuYooQ+BXcBlj37tCAPnHICehIv1aO6UXivKitEZU61/Qrowc15
+h2Er3oBXRb9n8ZuRXqWk7FlIEA04x7D6w0RtBPV4UBySllva9bguulvP5fBqnUsvWHMtTy3EHD70
+sz+rFQ47GUGKpMFXEmZxTPpT41frYpUJnlTd0cI8Vzy9OK2YZLe4A5pTVmBds9hCG1xLEooc6+t9
+xnppxyd/pPiL8uSUZodL6ZQHCRJ5irLrdATczvREWeAWysUsWNc8e89ihmpQfTU2Zqf7N+cox9jQ
+raVplI/owd8k+BsHMYeB2F326CjYSlKArBPuUBQemMc=
+-----END CERTIFICATE-----
+
+D-TRUST BR Root CA 1 2020
+=========================
+-----BEGIN CERTIFICATE-----
+MIIC2zCCAmCgAwIBAgIQfMmPK4TX3+oPyWWa00tNljAKBggqhkjOPQQDAzBIMQswCQYDVQQGEwJE
+RTEVMBMGA1UEChMMRC1UcnVzdCBHbWJIMSIwIAYDVQQDExlELVRSVVNUIEJSIFJvb3QgQ0EgMSAy
+MDIwMB4XDTIwMDIxMTA5NDUwMFoXDTM1MDIxMTA5NDQ1OVowSDELMAkGA1UEBhMCREUxFTATBgNV
+BAoTDEQtVHJ1c3QgR21iSDEiMCAGA1UEAxMZRC1UUlVTVCBCUiBSb290IENBIDEgMjAyMDB2MBAG
+ByqGSM49AgEGBSuBBAAiA2IABMbLxyjR+4T1mu9CFCDhQ2tuda38KwOE1HaTJddZO0Flax7mNCq7
+dPYSzuht56vkPE4/RAiLzRZxy7+SmfSk1zxQVFKQhYN4lGdnoxwJGT11NIXe7WB9xwy0QVK5buXu
+QqOCAQ0wggEJMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFHOREKv/VbNafAkl1bK6CKBrqx9t
+MA4GA1UdDwEB/wQEAwIBBjCBxgYDVR0fBIG+MIG7MD6gPKA6hjhodHRwOi8vY3JsLmQtdHJ1c3Qu
+bmV0L2NybC9kLXRydXN0X2JyX3Jvb3RfY2FfMV8yMDIwLmNybDB5oHegdYZzbGRhcDovL2RpcmVj
+dG9yeS5kLXRydXN0Lm5ldC9DTj1ELVRSVVNUJTIwQlIlMjBSb290JTIwQ0ElMjAxJTIwMjAyMCxP
+PUQtVHJ1c3QlMjBHbWJILEM9REU/Y2VydGlmaWNhdGVyZXZvY2F0aW9ubGlzdDAKBggqhkjOPQQD
+AwNpADBmAjEAlJAtE/rhY/hhY+ithXhUkZy4kzg+GkHaQBZTQgjKL47xPoFWwKrY7RjEsK70Pvom
+AjEA8yjixtsrmfu3Ubgko6SUeho/5jbiA1czijDLgsfWFBHVdWNbFJWcHwHP2NVypw87
+-----END CERTIFICATE-----
+
+D-TRUST EV Root CA 1 2020
+=========================
+-----BEGIN CERTIFICATE-----
+MIIC2zCCAmCgAwIBAgIQXwJB13qHfEwDo6yWjfv/0DAKBggqhkjOPQQDAzBIMQswCQYDVQQGEwJE
+RTEVMBMGA1UEChMMRC1UcnVzdCBHbWJIMSIwIAYDVQQDExlELVRSVVNUIEVWIFJvb3QgQ0EgMSAy
+MDIwMB4XDTIwMDIxMTEwMDAwMFoXDTM1MDIxMTA5NTk1OVowSDELMAkGA1UEBhMCREUxFTATBgNV
+BAoTDEQtVHJ1c3QgR21iSDEiMCAGA1UEAxMZRC1UUlVTVCBFViBSb290IENBIDEgMjAyMDB2MBAG
+ByqGSM49AgEGBSuBBAAiA2IABPEL3YZDIBnfl4XoIkqbz52Yv7QFJsnL46bSj8WeeHsxiamJrSc8
+ZRCC/N/DnU7wMyPE0jL1HLDfMxddxfCxivnvubcUyilKwg+pf3VlSSowZ/Rk99Yad9rDwpdhQntJ
+raOCAQ0wggEJMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFH8QARY3OqQo5FD4pPfsazK2/umL
+MA4GA1UdDwEB/wQEAwIBBjCBxgYDVR0fBIG+MIG7MD6gPKA6hjhodHRwOi8vY3JsLmQtdHJ1c3Qu
+bmV0L2NybC9kLXRydXN0X2V2X3Jvb3RfY2FfMV8yMDIwLmNybDB5oHegdYZzbGRhcDovL2RpcmVj
+dG9yeS5kLXRydXN0Lm5ldC9DTj1ELVRSVVNUJTIwRVYlMjBSb290JTIwQ0ElMjAxJTIwMjAyMCxP
+PUQtVHJ1c3QlMjBHbWJILEM9REU/Y2VydGlmaWNhdGVyZXZvY2F0aW9ubGlzdDAKBggqhkjOPQQD
+AwNpADBmAjEAyjzGKnXCXnViOTYAYFqLwZOZzNnbQTs7h5kXO9XMT8oi96CAy/m0sRtW9XLS/BnR
+AjEAkfcwkz8QRitxpNA7RJvAKQIFskF3UfN5Wp6OFKBOQtJbgfM0agPnIjhQW+0ZT0MW
+-----END CERTIFICATE-----
+
+DigiCert TLS ECC P384 Root G5
+=============================
+-----BEGIN CERTIFICATE-----
+MIICGTCCAZ+gAwIBAgIQCeCTZaz32ci5PhwLBCou8zAKBggqhkjOPQQDAzBOMQswCQYDVQQGEwJV
+UzEXMBUGA1UEChMORGlnaUNlcnQsIEluYy4xJjAkBgNVBAMTHURpZ2lDZXJ0IFRMUyBFQ0MgUDM4
+NCBSb290IEc1MB4XDTIxMDExNTAwMDAwMFoXDTQ2MDExNDIzNTk1OVowTjELMAkGA1UEBhMCVVMx
+FzAVBgNVBAoTDkRpZ2lDZXJ0LCBJbmMuMSYwJAYDVQQDEx1EaWdpQ2VydCBUTFMgRUNDIFAzODQg
+Um9vdCBHNTB2MBAGByqGSM49AgEGBSuBBAAiA2IABMFEoc8Rl1Ca3iOCNQfN0MsYndLxf3c1Tzvd
+lHJS7cI7+Oz6e2tYIOyZrsn8aLN1udsJ7MgT9U7GCh1mMEy7H0cKPGEQQil8pQgO4CLp0zVozptj
+n4S1mU1YoI71VOeVyaNCMEAwHQYDVR0OBBYEFMFRRVBZqz7nLFr6ICISB4CIfBFqMA4GA1UdDwEB
+/wQEAwIBhjAPBgNVHRMBAf8EBTADAQH/MAoGCCqGSM49BAMDA2gAMGUCMQCJao1H5+z8blUD2Wds
+Jk6Dxv3J+ysTvLd6jLRl0mlpYxNjOyZQLgGheQaRnUi/wr4CMEfDFXuxoJGZSZOoPHzoRgaLLPIx
+AJSdYsiJvRmEFOml+wG4DXZDjC5Ty3zfDBeWUA==
+-----END CERTIFICATE-----
+
+DigiCert TLS RSA4096 Root G5
+============================
+-----BEGIN CERTIFICATE-----
+MIIFZjCCA06gAwIBAgIQCPm0eKj6ftpqMzeJ3nzPijANBgkqhkiG9w0BAQwFADBNMQswCQYDVQQG
+EwJVUzEXMBUGA1UEChMORGlnaUNlcnQsIEluYy4xJTAjBgNVBAMTHERpZ2lDZXJ0IFRMUyBSU0E0
+MDk2IFJvb3QgRzUwHhcNMjEwMTE1MDAwMDAwWhcNNDYwMTE0MjM1OTU5WjBNMQswCQYDVQQGEwJV
+UzEXMBUGA1UEChMORGlnaUNlcnQsIEluYy4xJTAjBgNVBAMTHERpZ2lDZXJ0IFRMUyBSU0E0MDk2
+IFJvb3QgRzUwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCz0PTJeRGd/fxmgefM1eS8
+7IE+ajWOLrfn3q/5B03PMJ3qCQuZvWxX2hhKuHisOjmopkisLnLlvevxGs3npAOpPxG02C+JFvuU
+AT27L/gTBaF4HI4o4EXgg/RZG5Wzrn4DReW+wkL+7vI8toUTmDKdFqgpwgscONyfMXdcvyej/Ces
+tyu9dJsXLfKB2l2w4SMXPohKEiPQ6s+d3gMXsUJKoBZMpG2T6T867jp8nVid9E6P/DsjyG244gXa
+zOvswzH016cpVIDPRFtMbzCe88zdH5RDnU1/cHAN1DrRN/BsnZvAFJNY781BOHW8EwOVfH/jXOnV
+DdXifBBiqmvwPXbzP6PosMH976pXTayGpxi0KcEsDr9kvimM2AItzVwv8n/vFfQMFawKsPHTDU9q
+TXeXAaDxZre3zu/O7Oyldcqs4+Fj97ihBMi8ez9dLRYiVu1ISf6nL3kwJZu6ay0/nTvEF+cdLvvy
+z6b84xQslpghjLSR6Rlgg/IwKwZzUNWYOwbpx4oMYIwo+FKbbuH2TbsGJJvXKyY//SovcfXWJL5/
+MZ4PbeiPT02jP/816t9JXkGPhvnxd3lLG7SjXi/7RgLQZhNeXoVPzthwiHvOAbWWl9fNff2C+MIk
+wcoBOU+NosEUQB+cZtUMCUbW8tDRSHZWOkPLtgoRObqME2wGtZ7P6wIDAQABo0IwQDAdBgNVHQ4E
+FgQUUTMc7TZArxfTJc1paPKvTiM+s0EwDgYDVR0PAQH/BAQDAgGGMA8GA1UdEwEB/wQFMAMBAf8w
+DQYJKoZIhvcNAQEMBQADggIBAGCmr1tfV9qJ20tQqcQjNSH/0GEwhJG3PxDPJY7Jv0Y02cEhJhxw
+GXIeo8mH/qlDZJY6yFMECrZBu8RHANmfGBg7sg7zNOok992vIGCukihfNudd5N7HPNtQOa27PShN
+lnx2xlv0wdsUpasZYgcYQF+Xkdycx6u1UQ3maVNVzDl92sURVXLFO4uJ+DQtpBflF+aZfTCIITfN
+MBc9uPK8qHWgQ9w+iUuQrm0D4ByjoJYJu32jtyoQREtGBzRj7TG5BO6jm5qu5jF49OokYTurWGT/
+u4cnYiWB39yhL/btp/96j1EuMPikAdKFOV8BmZZvWltwGUb+hmA+rYAQCd05JS9Yf7vSdPD3Rh9G
+OUrYU9DzLjtxpdRv/PNn5AeP3SYZ4Y1b+qOTEZvpyDrDVWiakuFSdjjo4bq9+0/V77PnSIMx8IIh
+47a+p6tv75/fTM8BuGJqIz3nCU2AG3swpMPdB380vqQmsvZB6Akd4yCYqjdP//fx4ilwMUc/dNAU
+FvohigLVigmUdy7yWSiLfFCSCmZ4OIN1xLVaqBHG5cGdZlXPU8Sv13WFqUITVuwhd4GTWgzqltlJ
+yqEI8pc7bZsEGCREjnwB8twl2F6GmrE52/WRMmrRpnCKovfepEWFJqgejF0pW8hL2JpqA15w8oVP
+bEtoL8pU9ozaMv7Da4M/OMZ+
+-----END CERTIFICATE-----
+
+Certainly Root R1
+=================
+-----BEGIN CERTIFICATE-----
+MIIFRzCCAy+gAwIBAgIRAI4P+UuQcWhlM1T01EQ5t+AwDQYJKoZIhvcNAQELBQAwPTELMAkGA1UE
+BhMCVVMxEjAQBgNVBAoTCUNlcnRhaW5seTEaMBgGA1UEAxMRQ2VydGFpbmx5IFJvb3QgUjEwHhcN
+MjEwNDAxMDAwMDAwWhcNNDYwNDAxMDAwMDAwWjA9MQswCQYDVQQGEwJVUzESMBAGA1UEChMJQ2Vy
+dGFpbmx5MRowGAYDVQQDExFDZXJ0YWlubHkgUm9vdCBSMTCCAiIwDQYJKoZIhvcNAQEBBQADggIP
+ADCCAgoCggIBANA21B/q3avk0bbm+yLA3RMNansiExyXPGhjZjKcA7WNpIGD2ngwEc/csiu+kr+O
+5MQTvqRoTNoCaBZ0vrLdBORrKt03H2As2/X3oXyVtwxwhi7xOu9S98zTm/mLvg7fMbedaFySpvXl
+8wo0tf97ouSHocavFwDvA5HtqRxOcT3Si2yJ9HiG5mpJoM610rCrm/b01C7jcvk2xusVtyWMOvwl
+DbMicyF0yEqWYZL1LwsYpfSt4u5BvQF5+paMjRcCMLT5r3gajLQ2EBAHBXDQ9DGQilHFhiZ5shGI
+XsXwClTNSaa/ApzSRKft43jvRl5tcdF5cBxGX1HpyTfcX35pe0HfNEXgO4T0oYoKNp43zGJS4YkN
+KPl6I7ENPT2a/Z2B7yyQwHtETrtJ4A5KVpK8y7XdeReJkd5hiXSSqOMyhb5OhaRLWcsrxXiOcVTQ
+AjeZjOVJ6uBUcqQRBi8LjMFbvrWhsFNunLhgkR9Za/kt9JQKl7XsxXYDVBtlUrpMklZRNaBA2Cnb
+rlJ2Oy0wQJuK0EJWtLeIAaSHO1OWzaMWj/Nmqhexx2DgwUMFDO6bW2BvBlyHWyf5QBGenDPBt+U1
+VwV/J84XIIwc/PH72jEpSe31C4SnT8H2TsIonPru4K8H+zMReiFPCyEQtkA6qyI6BJyLm4SGcprS
+p6XEtHWRqSsjAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0GA1Ud
+DgQWBBTgqj8ljZ9EXME66C6ud0yEPmcM9DANBgkqhkiG9w0BAQsFAAOCAgEAuVevuBLaV4OPaAsz
+HQNTVfSVcOQrPbA56/qJYv331hgELyE03fFo8NWWWt7CgKPBjcZq91l3rhVkz1t5BXdm6ozTaw3d
+8VkswTOlMIAVRQdFGjEitpIAq5lNOo93r6kiyi9jyhXWx8bwPWz8HA2YEGGeEaIi1wrykXprOQ4v
+MMM2SZ/g6Q8CRFA3lFV96p/2O7qUpUzpvD5RtOjKkjZUbVwlKNrdrRT90+7iIgXr0PK3aBLXWopB
+GsaSpVo7Y0VPv+E6dyIvXL9G+VoDhRNCX8reU9ditaY1BMJH/5n9hN9czulegChB8n3nHpDYT3Y+
+gjwN/KUD+nsa2UUeYNrEjvn8K8l7lcUq/6qJ34IxD3L/DCfXCh5WAFAeDJDBlrXYFIW7pw0WwfgH
+JBu6haEaBQmAupVjyTrsJZ9/nbqkRxWbRHDxakvWOF5D8xh+UG7pWijmZeZ3Gzr9Hb4DJqPb1OG7
+fpYnKx3upPvaJVQTA945xsMfTZDsjxtK0hzthZU4UHlG1sGQUDGpXJpuHfUzVounmdLyyCwzk5Iw
+x06MZTMQZBf9JBeW0Y3COmor6xOLRPIh80oat3df1+2IpHLlOR+Vnb5nwXARPbv0+Em34yaXOp/S
+X3z7wJl8OSngex2/DaeP0ik0biQVy96QXr8axGbqwua6OV+KmalBWQewLK8=
+-----END CERTIFICATE-----
+
+Certainly Root E1
+=================
+-----BEGIN CERTIFICATE-----
+MIIB9zCCAX2gAwIBAgIQBiUzsUcDMydc+Y2aub/M+DAKBggqhkjOPQQDAzA9MQswCQYDVQQGEwJV
+UzESMBAGA1UEChMJQ2VydGFpbmx5MRowGAYDVQQDExFDZXJ0YWlubHkgUm9vdCBFMTAeFw0yMTA0
+MDEwMDAwMDBaFw00NjA0MDEwMDAwMDBaMD0xCzAJBgNVBAYTAlVTMRIwEAYDVQQKEwlDZXJ0YWlu
+bHkxGjAYBgNVBAMTEUNlcnRhaW5seSBSb290IEUxMHYwEAYHKoZIzj0CAQYFK4EEACIDYgAE3m/4
+fxzf7flHh4axpMCK+IKXgOqPyEpeKn2IaKcBYhSRJHpcnqMXfYqGITQYUBsQ3tA3SybHGWCA6TS9
+YBk2QNYphwk8kXr2vBMj3VlOBF7PyAIcGFPBMdjaIOlEjeR2o0IwQDAOBgNVHQ8BAf8EBAMCAQYw
+DwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQU8ygYy2R17ikq6+2uI1g4hevIIgcwCgYIKoZIzj0E
+AwMDaAAwZQIxALGOWiDDshliTd6wT99u0nCK8Z9+aozmut6Dacpps6kFtZaSF4fC0urQe87YQVt8
+rgIwRt7qy12a7DLCZRawTDBcMPPaTnOGBtjOiQRINzf43TNRnXCve1XYAS59BWQOhriR
+-----END CERTIFICATE-----
+
+Security Communication RootCA3
+==============================
+-----BEGIN CERTIFICATE-----
+MIIFfzCCA2egAwIBAgIJAOF8N0D9G/5nMA0GCSqGSIb3DQEBDAUAMF0xCzAJBgNVBAYTAkpQMSUw
+IwYDVQQKExxTRUNPTSBUcnVzdCBTeXN0ZW1zIENPLixMVEQuMScwJQYDVQQDEx5TZWN1cml0eSBD
+b21tdW5pY2F0aW9uIFJvb3RDQTMwHhcNMTYwNjE2MDYxNzE2WhcNMzgwMTE4MDYxNzE2WjBdMQsw
+CQYDVQQGEwJKUDElMCMGA1UEChMcU0VDT00gVHJ1c3QgU3lzdGVtcyBDTy4sTFRELjEnMCUGA1UE
+AxMeU2VjdXJpdHkgQ29tbXVuaWNhdGlvbiBSb290Q0EzMIICIjANBgkqhkiG9w0BAQEFAAOCAg8A
+MIICCgKCAgEA48lySfcw3gl8qUCBWNO0Ot26YQ+TUG5pPDXC7ltzkBtnTCHsXzW7OT4rCmDvu20r
+hvtxosis5FaU+cmvsXLUIKx00rgVrVH+hXShuRD+BYD5UpOzQD11EKzAlrenfna84xtSGc4RHwsE
+NPXY9Wk8d/Nk9A2qhd7gCVAEF5aEt8iKvE1y/By7z/MGTfmfZPd+pmaGNXHIEYBMwXFAWB6+oHP2
+/D5Q4eAvJj1+XCO1eXDe+uDRpdYMQXF79+qMHIjH7Iv10S9VlkZ8WjtYO/u62C21Jdp6Ts9EriGm
+npjKIG58u4iFW/vAEGK78vknR+/RiTlDxN/e4UG/VHMgly1s2vPUB6PmudhvrvyMGS7TZ2crldtY
+XLVqAvO4g160a75BflcJdURQVc1aEWEhCmHCqYj9E7wtiS/NYeCVvsq1e+F7NGcLH7YMx3weGVPK
+p7FKFSBWFHA9K4IsD50VHUeAR/94mQ4xr28+j+2GaR57GIgUssL8gjMunEst+3A7caoreyYn8xrC
+3PsXuKHqy6C0rtOUfnrQq8PsOC0RLoi/1D+tEjtCrI8Cbn3M0V9hvqG8OmpI6iZVIhZdXw3/JzOf
+GAN0iltSIEdrRU0id4xVJ/CvHozJgyJUt5rQT9nO/NkuHJYosQLTA70lUhw0Zk8jq/R3gpYd0Vcw
+CBEF/VfR2ccCAwEAAaNCMEAwHQYDVR0OBBYEFGQUfPxYchamCik0FW8qy7z8r6irMA4GA1UdDwEB
+/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEBDAUAA4ICAQDcAiMI4u8hOscNtybS
+YpOnpSNyByCCYN8Y11StaSWSntkUz5m5UoHPrmyKO1o5yGwBQ8IibQLwYs1OY0PAFNr0Y/Dq9HHu
+Tofjcan0yVflLl8cebsjqodEV+m9NU1Bu0soo5iyG9kLFwfl9+qd9XbXv8S2gVj/yP9kaWJ5rW4O
+H3/uHWnlt3Jxs/6lATWUVCvAUm2PVcTJ0rjLyjQIUYWg9by0F1jqClx6vWPGOi//lkkZhOpn2ASx
+YfQAW0q3nHE3GYV5v4GwxxMOdnE+OoAGrgYWp421wsTL/0ClXI2lyTrtcoHKXJg80jQDdwj98ClZ
+XSEIx2C/pHF7uNkegr4Jr2VvKKu/S7XuPghHJ6APbw+LP6yVGPO5DtxnVW5inkYO0QR4ynKudtml
++LLfiAlhi+8kTtFZP1rUPcmTPCtk9YENFpb3ksP+MW/oKjJ0DvRMmEoYDjBU1cXrvMUVnuiZIesn
+KwkK2/HmcBhWuwzkvvnoEKQTkrgc4NtnHVMDpCKn3F2SEDzq//wbEBrD2NCcnWXL0CsnMQMeNuE9
+dnUM/0Umud1RvCPHX9jYhxBAEg09ODfnRDwYwFMJZI//1ZqmfHAuc1Uh6N//g7kdPjIe1qZ9LPFm
+6Vwdp6POXiUyK+OVrCoHzrQoeIY8LaadTdJ0MN1kURXbg4NR16/9M51NZg==
+-----END CERTIFICATE-----
+
+Security Communication ECC RootCA1
+==================================
+-----BEGIN CERTIFICATE-----
+MIICODCCAb6gAwIBAgIJANZdm7N4gS7rMAoGCCqGSM49BAMDMGExCzAJBgNVBAYTAkpQMSUwIwYD
+VQQKExxTRUNPTSBUcnVzdCBTeXN0ZW1zIENPLixMVEQuMSswKQYDVQQDEyJTZWN1cml0eSBDb21t
+dW5pY2F0aW9uIEVDQyBSb290Q0ExMB4XDTE2MDYxNjA1MTUyOFoXDTM4MDExODA1MTUyOFowYTEL
+MAkGA1UEBhMCSlAxJTAjBgNVBAoTHFNFQ09NIFRydXN0IFN5c3RlbXMgQ08uLExURC4xKzApBgNV
+BAMTIlNlY3VyaXR5IENvbW11bmljYXRpb24gRUNDIFJvb3RDQTEwdjAQBgcqhkjOPQIBBgUrgQQA
+IgNiAASkpW9gAwPDvTH00xecK4R1rOX9PVdu12O/5gSJko6BnOPpR27KkBLIE+CnnfdldB9sELLo
+5OnvbYUymUSxXv3MdhDYW72ixvnWQuRXdtyQwjWpS4g8EkdtXP9JTxpKULGjQjBAMB0GA1UdDgQW
+BBSGHOf+LaVKiwj+KBH6vqNm+GBZLzAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAK
+BggqhkjOPQQDAwNoADBlAjAVXUI9/Lbu9zuxNuie9sRGKEkz0FhDKmMpzE2xtHqiuQ04pV1IKv3L
+snNdo4gIxwwCMQDAqy0Obe0YottT6SXbVQjgUMzfRGEWgqtJsLKB7HOHeLRMsmIbEvoWTSVLY70e
+N9k=
+-----END CERTIFICATE-----
+
+BJCA Global Root CA1
+====================
+-----BEGIN CERTIFICATE-----
+MIIFdDCCA1ygAwIBAgIQVW9l47TZkGobCdFsPsBsIDANBgkqhkiG9w0BAQsFADBUMQswCQYDVQQG
+EwJDTjEmMCQGA1UECgwdQkVJSklORyBDRVJUSUZJQ0FURSBBVVRIT1JJVFkxHTAbBgNVBAMMFEJK
+Q0EgR2xvYmFsIFJvb3QgQ0ExMB4XDTE5MTIxOTAzMTYxN1oXDTQ0MTIxMjAzMTYxN1owVDELMAkG
+A1UEBhMCQ04xJjAkBgNVBAoMHUJFSUpJTkcgQ0VSVElGSUNBVEUgQVVUSE9SSVRZMR0wGwYDVQQD
+DBRCSkNBIEdsb2JhbCBSb290IENBMTCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAPFm
+CL3ZxRVhy4QEQaVpN3cdwbB7+sN3SJATcmTRuHyQNZ0YeYjjlwE8R4HyDqKYDZ4/N+AZspDyRhyS
+sTphzvq3Rp4Dhtczbu33RYx2N95ulpH3134rhxfVizXuhJFyV9xgw8O558dnJCNPYwpj9mZ9S1Wn
+P3hkSWkSl+BMDdMJoDIwOvqfwPKcxRIqLhy1BDPapDgRat7GGPZHOiJBhyL8xIkoVNiMpTAK+BcW
+yqw3/XmnkRd4OJmtWO2y3syJfQOcs4ll5+M7sSKGjwZteAf9kRJ/sGsciQ35uMt0WwfCyPQ10WRj
+eulumijWML3mG90Vr4TqnMfK9Q7q8l0ph49pczm+LiRvRSGsxdRpJQaDrXpIhRMsDQa4bHlW/KNn
+MoH1V6XKV0Jp6VwkYe/iMBhORJhVb3rCk9gZtt58R4oRTklH2yiUAguUSiz5EtBP6DF+bHq/pj+b
+OT0CFqMYs2esWz8sgytnOYFcuX6U1WTdno9uruh8W7TXakdI136z1C2OVnZOz2nxbkRs1CTqjSSh
+GL+9V/6pmTW12xB3uD1IutbB5/EjPtffhZ0nPNRAvQoMvfXnjSXWgXSHRtQpdaJCbPdzied9v3pK
+H9MiyRVVz99vfFXQpIsHETdfg6YmV6YBW37+WGgHqel62bno/1Afq8K0wM7o6v0PvY1NuLxxAgMB
+AAGjQjBAMB0GA1UdDgQWBBTF7+3M2I0hxkjk49cULqcWk+WYATAPBgNVHRMBAf8EBTADAQH/MA4G
+A1UdDwEB/wQEAwIBBjANBgkqhkiG9w0BAQsFAAOCAgEAUoKsITQfI/Ki2Pm4rzc2IInRNwPWaZ+4
+YRC6ojGYWUfo0Q0lHhVBDOAqVdVXUsv45Mdpox1NcQJeXyFFYEhcCY5JEMEE3KliawLwQ8hOnThJ
+dMkycFRtwUf8jrQ2ntScvd0g1lPJGKm1Vrl2i5VnZu69mP6u775u+2D2/VnGKhs/I0qUJDAnyIm8
+60Qkmss9vk/Ves6OF8tiwdneHg56/0OGNFK8YT88X7vZdrRTvJez/opMEi4r89fO4aL/3Xtw+zuh
+TaRjAv04l5U/BXCga99igUOLtFkNSoxUnMW7gZ/NfaXvCyUeOiDbHPwfmGcCCtRzRBPbUYQaVQNW
+4AB+dAb/OMRyHdOoP2gxXdMJxy6MW2Pg6Nwe0uxhHvLe5e/2mXZgLR6UcnHGCyoyx5JO1UbXHfmp
+GQrI+pXObSOYqgs4rZpWDW+N8TEAiMEXnM0ZNjX+VVOg4DwzX5Ze4jLp3zO7Bkqp2IRzznfSxqxx
+4VyjHQy7Ct9f4qNx2No3WqB4K/TUfet27fJhcKVlmtOJNBir+3I+17Q9eVzYH6Eze9mCUAyTF6ps
+3MKCuwJXNq+YJyo5UOGwifUll35HaBC07HPKs5fRJNz2YqAo07WjuGS3iGJCz51TzZm+ZGiPTx4S
+SPfSKcOYKMryMguTjClPPGAyzQWWYezyr/6zcCwupvI=
+-----END CERTIFICATE-----
+
+BJCA Global Root CA2
+====================
+-----BEGIN CERTIFICATE-----
+MIICJTCCAaugAwIBAgIQLBcIfWQqwP6FGFkGz7RK6zAKBggqhkjOPQQDAzBUMQswCQYDVQQGEwJD
+TjEmMCQGA1UECgwdQkVJSklORyBDRVJUSUZJQ0FURSBBVVRIT1JJVFkxHTAbBgNVBAMMFEJKQ0Eg
+R2xvYmFsIFJvb3QgQ0EyMB4XDTE5MTIxOTAzMTgyMVoXDTQ0MTIxMjAzMTgyMVowVDELMAkGA1UE
+BhMCQ04xJjAkBgNVBAoMHUJFSUpJTkcgQ0VSVElGSUNBVEUgQVVUSE9SSVRZMR0wGwYDVQQDDBRC
+SkNBIEdsb2JhbCBSb290IENBMjB2MBAGByqGSM49AgEGBSuBBAAiA2IABJ3LgJGNU2e1uVCxA/jl
+SR9BIgmwUVJY1is0j8USRhTFiy8shP8sbqjV8QnjAyEUxEM9fMEsxEtqSs3ph+B99iK++kpRuDCK
+/eHeGBIK9ke35xe/J4rUQUyWPGCWwf0VHKNCMEAwHQYDVR0OBBYEFNJKsVF/BvDRgh9Obl+rg/xI
+1LCRMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMAoGCCqGSM49BAMDA2gAMGUCMBq8
+W9f+qdJUDkpd0m2xQNz0Q9XSSpkZElaA94M04TVOSG0ED1cxMDAtsaqdAzjbBgIxAMvMh1PLet8g
+UXOQwKhbYdDFUDn9hf7B43j4ptZLvZuHjw/l1lOWqzzIQNph91Oj9w==
+-----END CERTIFICATE-----
+
+Sectigo Public Server Authentication Root E46
+=============================================
+-----BEGIN CERTIFICATE-----
+MIICOjCCAcGgAwIBAgIQQvLM2htpN0RfFf51KBC49DAKBggqhkjOPQQDAzBfMQswCQYDVQQGEwJH
+QjEYMBYGA1UEChMPU2VjdGlnbyBMaW1pdGVkMTYwNAYDVQQDEy1TZWN0aWdvIFB1YmxpYyBTZXJ2
+ZXIgQXV0aGVudGljYXRpb24gUm9vdCBFNDYwHhcNMjEwMzIyMDAwMDAwWhcNNDYwMzIxMjM1OTU5
+WjBfMQswCQYDVQQGEwJHQjEYMBYGA1UEChMPU2VjdGlnbyBMaW1pdGVkMTYwNAYDVQQDEy1TZWN0
+aWdvIFB1YmxpYyBTZXJ2ZXIgQXV0aGVudGljYXRpb24gUm9vdCBFNDYwdjAQBgcqhkjOPQIBBgUr
+gQQAIgNiAAR2+pmpbiDt+dd34wc7qNs9Xzjoq1WmVk/WSOrsfy2qw7LFeeyZYX8QeccCWvkEN/U0
+NSt3zn8gj1KjAIns1aeibVvjS5KToID1AZTc8GgHHs3u/iVStSBDHBv+6xnOQ6OjQjBAMB0GA1Ud
+DgQWBBTRItpMWfFLXyY4qp3W7usNw/upYTAOBgNVHQ8BAf8EBAMCAYYwDwYDVR0TAQH/BAUwAwEB
+/zAKBggqhkjOPQQDAwNnADBkAjAn7qRaqCG76UeXlImldCBteU/IvZNeWBj7LRoAasm4PdCkT0RH
+lAFWovgzJQxC36oCMB3q4S6ILuH5px0CMk7yn2xVdOOurvulGu7t0vzCAxHrRVxgED1cf5kDW21U
+SAGKcw==
+-----END CERTIFICATE-----
+
+Sectigo Public Server Authentication Root R46
+=============================================
+-----BEGIN CERTIFICATE-----
+MIIFijCCA3KgAwIBAgIQdY39i658BwD6qSWn4cetFDANBgkqhkiG9w0BAQwFADBfMQswCQYDVQQG
+EwJHQjEYMBYGA1UEChMPU2VjdGlnbyBMaW1pdGVkMTYwNAYDVQQDEy1TZWN0aWdvIFB1YmxpYyBT
+ZXJ2ZXIgQXV0aGVudGljYXRpb24gUm9vdCBSNDYwHhcNMjEwMzIyMDAwMDAwWhcNNDYwMzIxMjM1
+OTU5WjBfMQswCQYDVQQGEwJHQjEYMBYGA1UEChMPU2VjdGlnbyBMaW1pdGVkMTYwNAYDVQQDEy1T
+ZWN0aWdvIFB1YmxpYyBTZXJ2ZXIgQXV0aGVudGljYXRpb24gUm9vdCBSNDYwggIiMA0GCSqGSIb3
+DQEBAQUAA4ICDwAwggIKAoICAQCTvtU2UnXYASOgHEdCSe5jtrch/cSV1UgrJnwUUxDaef0rty2k
+1Cz66jLdScK5vQ9IPXtamFSvnl0xdE8H/FAh3aTPaE8bEmNtJZlMKpnzSDBh+oF8HqcIStw+Kxwf
+GExxqjWMrfhu6DtK2eWUAtaJhBOqbchPM8xQljeSM9xfiOefVNlI8JhD1mb9nxc4Q8UBUQvX4yMP
+FF1bFOdLvt30yNoDN9HWOaEhUTCDsG3XME6WW5HwcCSrv0WBZEMNvSE6Lzzpng3LILVCJ8zab5vu
+ZDCQOc2TZYEhMbUjUDM3IuM47fgxMMxF/mL50V0yeUKH32rMVhlATc6qu/m1dkmU8Sf4kaWD5Qaz
+Yw6A3OASVYCmO2a0OYctyPDQ0RTp5A1NDvZdV3LFOxxHVp3i1fuBYYzMTYCQNFu31xR13NgESJ/A
+wSiItOkcyqex8Va3e0lMWeUgFaiEAin6OJRpmkkGj80feRQXEgyDet4fsZfu+Zd4KKTIRJLpfSYF
+plhym3kT2BFfrsU4YjRosoYwjviQYZ4ybPUHNs2iTG7sijbt8uaZFURww3y8nDnAtOFr94MlI1fZ
+EoDlSfB1D++N6xybVCi0ITz8fAr/73trdf+LHaAZBav6+CuBQug4urv7qv094PPK306Xlynt8xhW
+6aWWrL3DkJiy4Pmi1KZHQ3xtzwIDAQABo0IwQDAdBgNVHQ4EFgQUVnNYZJX5khqwEioEYnmhQBWI
+IUkwDgYDVR0PAQH/BAQDAgGGMA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZIhvcNAQEMBQADggIBAC9c
+mTz8Bl6MlC5w6tIyMY208FHVvArzZJ8HXtXBc2hkeqK5Duj5XYUtqDdFqij0lgVQYKlJfp/imTYp
+E0RHap1VIDzYm/EDMrraQKFz6oOht0SmDpkBm+S8f74TlH7Kph52gDY9hAaLMyZlbcp+nv4fjFg4
+exqDsQ+8FxG75gbMY/qB8oFM2gsQa6H61SilzwZAFv97fRheORKkU55+MkIQpiGRqRxOF3yEvJ+M
+0ejf5lG5Nkc/kLnHvALcWxxPDkjBJYOcCj+esQMzEhonrPcibCTRAUH4WAP+JWgiH5paPHxsnnVI
+84HxZmduTILA7rpXDhjvLpr3Etiga+kFpaHpaPi8TD8SHkXoUsCjvxInebnMMTzD9joiFgOgyY9m
+pFuiTdaBJQbpdqQACj7LzTWb4OE4y2BThihCQRxEV+ioratF4yUQvNs+ZUH7G6aXD+u5dHn5Hrwd
+Vw1Hr8Mvn4dGp+smWg9WY7ViYG4A++MnESLn/pmPNPW56MORcr3Ywx65LvKRRFHQV80MNNVIIb/b
+E/FmJUNS0nAiNs2fxBx1IK1jcmMGDw4nztJqDby1ORrp0XZ60Vzk50lJLVU3aPAaOpg+VBeHVOmm
+J1CJeyAvP/+/oYtKR5j/K3tJPsMpRmAYQqszKbrAKbkTidOIijlBO8n9pu0f9GBj39ItVQGL
+-----END CERTIFICATE-----
+
+SSL.com TLS RSA Root CA 2022
+============================
+-----BEGIN CERTIFICATE-----
+MIIFiTCCA3GgAwIBAgIQb77arXO9CEDii02+1PdbkTANBgkqhkiG9w0BAQsFADBOMQswCQYDVQQG
+EwJVUzEYMBYGA1UECgwPU1NMIENvcnBvcmF0aW9uMSUwIwYDVQQDDBxTU0wuY29tIFRMUyBSU0Eg
+Um9vdCBDQSAyMDIyMB4XDTIyMDgyNTE2MzQyMloXDTQ2MDgxOTE2MzQyMVowTjELMAkGA1UEBhMC
+VVMxGDAWBgNVBAoMD1NTTCBDb3Jwb3JhdGlvbjElMCMGA1UEAwwcU1NMLmNvbSBUTFMgUlNBIFJv
+b3QgQ0EgMjAyMjCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBANCkCXJPQIgSYT41I57u
+9nTPL3tYPc48DRAokC+X94xI2KDYJbFMsBFMF3NQ0CJKY7uB0ylu1bUJPiYYf7ISf5OYt6/wNr/y
+7hienDtSxUcZXXTzZGbVXcdotL8bHAajvI9AI7YexoS9UcQbOcGV0insS657Lb85/bRi3pZ7Qcac
+oOAGcvvwB5cJOYF0r/c0WRFXCsJbwST0MXMwgsadugL3PnxEX4MN8/HdIGkWCVDi1FW24IBydm5M
+R7d1VVm0U3TZlMZBrViKMWYPHqIbKUBOL9975hYsLfy/7PO0+r4Y9ptJ1O4Fbtk085zx7AGL0SDG
+D6C1vBdOSHtRwvzpXGk3R2azaPgVKPC506QVzFpPulJwoxJF3ca6TvvC0PeoUidtbnm1jPx7jMEW
+TO6Af77wdr5BUxIzrlo4QqvXDz5BjXYHMtWrifZOZ9mxQnUjbvPNQrL8VfVThxc7wDNY8VLS+YCk
+8OjwO4s4zKTGkH8PnP2L0aPP2oOnaclQNtVcBdIKQXTbYxE3waWglksejBYSd66UNHsef8JmAOSq
+g+qKkK3ONkRN0VHpvB/zagX9wHQfJRlAUW7qglFA35u5CCoGAtUjHBPW6dvbxrB6y3snm/vg1UYk
+7RBLY0ulBY+6uB0rpvqR4pJSvezrZ5dtmi2fgTIFZzL7SAg/2SW4BCUvAgMBAAGjYzBhMA8GA1Ud
+EwEB/wQFMAMBAf8wHwYDVR0jBBgwFoAU+y437uOEeicuzRk1sTN8/9REQrkwHQYDVR0OBBYEFPsu
+N+7jhHonLs0ZNbEzfP/UREK5MA4GA1UdDwEB/wQEAwIBhjANBgkqhkiG9w0BAQsFAAOCAgEAjYlt
+hEUY8U+zoO9opMAdrDC8Z2awms22qyIZZtM7QbUQnRC6cm4pJCAcAZli05bg4vsMQtfhWsSWTVTN
+j8pDU/0quOr4ZcoBwq1gaAafORpR2eCNJvkLTqVTJXojpBzOCBvfR4iyrT7gJ4eLSYwfqUdYe5by
+iB0YrrPRpgqU+tvT5TgKa3kSM/tKWTcWQA673vWJDPFs0/dRa1419dvAJuoSc06pkZCmF8NsLzjU
+o3KUQyxi4U5cMj29TH0ZR6LDSeeWP4+a0zvkEdiLA9z2tmBVGKaBUfPhqBVq6+AL8BQx1rmMRTqo
+ENjwuSfr98t67wVylrXEj5ZzxOhWc5y8aVFjvO9nHEMaX3cZHxj4HCUp+UmZKbaSPaKDN7Egkaib
+MOlqbLQjk2UEqxHzDh1TJElTHaE/nUiSEeJ9DU/1172iWD54nR4fK/4huxoTtrEoZP2wAgDHbICi
+vRZQIA9ygV/MlP+7mea6kMvq+cYMwq7FGc4zoWtcu358NFcXrfA/rs3qr5nsLFR+jM4uElZI7xc7
+P0peYNLcdDa8pUNjyw9bowJWCZ4kLOGGgYz+qxcs+sjiMho6/4UIyYOf8kpIEFR3N+2ivEC+5BB0
+9+Rbu7nzifmPQdjH5FCQNYA+HLhNkNPU98OwoX6EyneSMSy4kLGCenROmxMmtNVQZlR4rmA=
+-----END CERTIFICATE-----
+
+SSL.com TLS ECC Root CA 2022
+============================
+-----BEGIN CERTIFICATE-----
+MIICOjCCAcCgAwIBAgIQFAP1q/s3ixdAW+JDsqXRxDAKBggqhkjOPQQDAzBOMQswCQYDVQQGEwJV
+UzEYMBYGA1UECgwPU1NMIENvcnBvcmF0aW9uMSUwIwYDVQQDDBxTU0wuY29tIFRMUyBFQ0MgUm9v
+dCBDQSAyMDIyMB4XDTIyMDgyNTE2MzM0OFoXDTQ2MDgxOTE2MzM0N1owTjELMAkGA1UEBhMCVVMx
+GDAWBgNVBAoMD1NTTCBDb3Jwb3JhdGlvbjElMCMGA1UEAwwcU1NMLmNvbSBUTFMgRUNDIFJvb3Qg
+Q0EgMjAyMjB2MBAGByqGSM49AgEGBSuBBAAiA2IABEUpNXP6wrgjzhR9qLFNoFs27iosU8NgCTWy
+JGYmacCzldZdkkAZDsalE3D07xJRKF3nzL35PIXBz5SQySvOkkJYWWf9lCcQZIxPBLFNSeR7T5v1
+5wj4A4j3p8OSSxlUgaNjMGEwDwYDVR0TAQH/BAUwAwEB/zAfBgNVHSMEGDAWgBSJjy+j6CugFFR7
+81a4Jl9nOAuc0DAdBgNVHQ4EFgQUiY8vo+groBRUe/NWuCZfZzgLnNAwDgYDVR0PAQH/BAQDAgGG
+MAoGCCqGSM49BAMDA2gAMGUCMFXjIlbp15IkWE8elDIPDAI2wv2sdDJO4fscgIijzPvX6yv/N33w
+7deedWo1dlJF4AIxAMeNb0Igj762TVntd00pxCAgRWSGOlDGxK0tk/UYfXLtqc/ErFc2KAhl3zx5
+Zn6g6g==
+-----END CERTIFICATE-----
+
+Atos TrustedRoot Root CA ECC TLS 2021
+=====================================
+-----BEGIN CERTIFICATE-----
+MIICFTCCAZugAwIBAgIQPZg7pmY9kGP3fiZXOATvADAKBggqhkjOPQQDAzBMMS4wLAYDVQQDDCVB
+dG9zIFRydXN0ZWRSb290IFJvb3QgQ0EgRUNDIFRMUyAyMDIxMQ0wCwYDVQQKDARBdG9zMQswCQYD
+VQQGEwJERTAeFw0yMTA0MjIwOTI2MjNaFw00MTA0MTcwOTI2MjJaMEwxLjAsBgNVBAMMJUF0b3Mg
+VHJ1c3RlZFJvb3QgUm9vdCBDQSBFQ0MgVExTIDIwMjExDTALBgNVBAoMBEF0b3MxCzAJBgNVBAYT
+AkRFMHYwEAYHKoZIzj0CAQYFK4EEACIDYgAEloZYKDcKZ9Cg3iQZGeHkBQcfl+3oZIK59sRxUM6K
+DP/XtXa7oWyTbIOiaG6l2b4siJVBzV3dscqDY4PMwL502eCdpO5KTlbgmClBk1IQ1SQ4AjJn8ZQS
+b+/Xxd4u/RmAo0IwQDAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBR2KCXWfeBmmnoJsmo7jjPX
+NtNPojAOBgNVHQ8BAf8EBAMCAYYwCgYIKoZIzj0EAwMDaAAwZQIwW5kp85wxtolrbNa9d+F851F+
+uDrNozZffPc8dz7kUK2o59JZDCaOMDtuCCrCp1rIAjEAmeMM56PDr9NJLkaCI2ZdyQAUEv049OGY
+a3cpetskz2VAv9LcjBHo9H1/IISpQuQo
+-----END CERTIFICATE-----
+
+Atos TrustedRoot Root CA RSA TLS 2021
+=====================================
+-----BEGIN CERTIFICATE-----
+MIIFZDCCA0ygAwIBAgIQU9XP5hmTC/srBRLYwiqipDANBgkqhkiG9w0BAQwFADBMMS4wLAYDVQQD
+DCVBdG9zIFRydXN0ZWRSb290IFJvb3QgQ0EgUlNBIFRMUyAyMDIxMQ0wCwYDVQQKDARBdG9zMQsw
+CQYDVQQGEwJERTAeFw0yMTA0MjIwOTIxMTBaFw00MTA0MTcwOTIxMDlaMEwxLjAsBgNVBAMMJUF0
+b3MgVHJ1c3RlZFJvb3QgUm9vdCBDQSBSU0EgVExTIDIwMjExDTALBgNVBAoMBEF0b3MxCzAJBgNV
+BAYTAkRFMIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAtoAOxHm9BYx9sKOdTSJNy/BB
+l01Z4NH+VoyX8te9j2y3I49f1cTYQcvyAh5x5en2XssIKl4w8i1mx4QbZFc4nXUtVsYvYe+W/CBG
+vevUez8/fEc4BKkbqlLfEzfTFRVOvV98r61jx3ncCHvVoOX3W3WsgFWZkmGbzSoXfduP9LVq6hdK
+ZChmFSlsAvFr1bqjM9xaZ6cF4r9lthawEO3NUDPJcFDsGY6wx/J0W2tExn2WuZgIWWbeKQGb9Cpt
+0xU6kGpn8bRrZtkh68rZYnxGEFzedUlnnkL5/nWpo63/dgpnQOPF943HhZpZnmKaau1Fh5hnstVK
+PNe0OwANwI8f4UDErmwh3El+fsqyjW22v5MvoVw+j8rtgI5Y4dtXz4U2OLJxpAmMkokIiEjxQGMY
+sluMWuPD0xeqqxmjLBvk1cbiZnrXghmmOxYsL3GHX0WelXOTwkKBIROW1527k2gV+p2kHYzygeBY
+Br3JtuP2iV2J+axEoctr+hbxx1A9JNr3w+SH1VbxT5Aw+kUJWdo0zuATHAR8ANSbhqRAvNncTFd+
+rrcztl524WWLZt+NyteYr842mIycg5kDcPOvdO3GDjbnvezBc6eUWsuSZIKmAMFwoW4sKeFYV+xa
+fJlrJaSQOoD0IJ2azsct+bJLKZWD6TWNp0lIpw9MGZHQ9b8Q4HECAwEAAaNCMEAwDwYDVR0TAQH/
+BAUwAwEB/zAdBgNVHQ4EFgQUdEmZ0f+0emhFdcN+tNzMzjkz2ggwDgYDVR0PAQH/BAQDAgGGMA0G
+CSqGSIb3DQEBDAUAA4ICAQAjQ1MkYlxt/T7Cz1UAbMVWiLkO3TriJQ2VSpfKgInuKs1l+NsW4AmS
+4BjHeJi78+xCUvuppILXTdiK/ORO/auQxDh1MoSf/7OwKwIzNsAQkG8dnK/haZPso0UvFJ/1TCpl
+Q3IM98P4lYsU84UgYt1UU90s3BiVaU+DR3BAM1h3Egyi61IxHkzJqM7F78PRreBrAwA0JrRUITWX
+AdxfG/F851X6LWh3e9NpzNMOa7pNdkTWwhWaJuywxfW70Xp0wmzNxbVe9kzmWy2B27O3Opee7c9G
+slA9hGCZcbUztVdF5kJHdWoOsAgMrr3e97sPWD2PAzHoPYJQyi9eDF20l74gNAf0xBLh7tew2Vkt
+afcxBPTy+av5EzH4AXcOPUIjJsyacmdRIXrMPIWo6iFqO9taPKU0nprALN+AnCng33eU0aKAQv9q
+TFsR0PXNor6uzFFcw9VUewyu1rkGd4Di7wcaaMxZUa1+XGdrudviB0JbuAEFWDlN5LuYo7Ey7Nmj
+1m+UI/87tyll5gfp77YZ6ufCOB0yiJA8EytuzO+rdwY0d4RPcuSBhPm5dDTedk+SKlOxJTnbPP/l
+PqYO5Wue/9vsL3SD3460s6neFE3/MaNFcyT6lSnMEpcEoji2jbDwN/zIIX8/syQbPYtuzE2wFg2W
+HYMfRsCbvUOZ58SWLs5fyQ==
+-----END CERTIFICATE-----
+
+TrustAsia Global Root CA G3
+===========================
+-----BEGIN CERTIFICATE-----
+MIIFpTCCA42gAwIBAgIUZPYOZXdhaqs7tOqFhLuxibhxkw8wDQYJKoZIhvcNAQEMBQAwWjELMAkG
+A1UEBhMCQ04xJTAjBgNVBAoMHFRydXN0QXNpYSBUZWNobm9sb2dpZXMsIEluYy4xJDAiBgNVBAMM
+G1RydXN0QXNpYSBHbG9iYWwgUm9vdCBDQSBHMzAeFw0yMTA1MjAwMjEwMTlaFw00NjA1MTkwMjEw
+MTlaMFoxCzAJBgNVBAYTAkNOMSUwIwYDVQQKDBxUcnVzdEFzaWEgVGVjaG5vbG9naWVzLCBJbmMu
+MSQwIgYDVQQDDBtUcnVzdEFzaWEgR2xvYmFsIFJvb3QgQ0EgRzMwggIiMA0GCSqGSIb3DQEBAQUA
+A4ICDwAwggIKAoICAQDAMYJhkuSUGwoqZdC+BqmHO1ES6nBBruL7dOoKjbmzTNyPtxNST1QY4Sxz
+lZHFZjtqz6xjbYdT8PfxObegQ2OwxANdV6nnRM7EoYNl9lA+sX4WuDqKAtCWHwDNBSHvBm3dIZwZ
+Q0WhxeiAysKtQGIXBsaqvPPW5vxQfmZCHzyLpnl5hkA1nyDvP+uLRx+PjsXUjrYsyUQE49RDdT/V
+P68czH5GX6zfZBCK70bwkPAPLfSIC7Epqq+FqklYqL9joDiR5rPmd2jE+SoZhLsO4fWvieylL1Ag
+dB4SQXMeJNnKziyhWTXAyB1GJ2Faj/lN03J5Zh6fFZAhLf3ti1ZwA0pJPn9pMRJpxx5cynoTi+jm
+9WAPzJMshH/x/Gr8m0ed262IPfN2dTPXS6TIi/n1Q1hPy8gDVI+lhXgEGvNz8teHHUGf59gXzhqc
+D0r83ERoVGjiQTz+LISGNzzNPy+i2+f3VANfWdP3kXjHi3dqFuVJhZBFcnAvkV34PmVACxmZySYg
+WmjBNb9Pp1Hx2BErW+Canig7CjoKH8GB5S7wprlppYiU5msTf9FkPz2ccEblooV7WIQn3MSAPmea
+mseaMQ4w7OYXQJXZRe0Blqq/DPNL0WP3E1jAuPP6Z92bfW1K/zJMtSU7/xxnD4UiWQWRkUF3gdCF
+TIcQcf+eQxuulXUtgQIDAQABo2MwYTAPBgNVHRMBAf8EBTADAQH/MB8GA1UdIwQYMBaAFEDk5PIj
+7zjKsK5Xf/IhMBY027ySMB0GA1UdDgQWBBRA5OTyI+84yrCuV3/yITAWNNu8kjAOBgNVHQ8BAf8E
+BAMCAQYwDQYJKoZIhvcNAQEMBQADggIBACY7UeFNOPMyGLS0XuFlXsSUT9SnYaP4wM8zAQLpw6o1
+D/GUE3d3NZ4tVlFEbuHGLige/9rsR82XRBf34EzC4Xx8MnpmyFq2XFNFV1pF1AWZLy4jVe5jaN/T
+G3inEpQGAHUNcoTpLrxaatXeL1nHo+zSh2bbt1S1JKv0Q3jbSwTEb93mPmY+KfJLaHEih6D4sTNj
+duMNhXJEIlU/HHzp/LgV6FL6qj6jITk1dImmasI5+njPtqzn59ZW/yOSLlALqbUHM/Q4X6RJpstl
+cHboCoWASzY9M/eVVHUl2qzEc4Jl6VL1XP04lQJqaTDFHApXB64ipCz5xUG3uOyfT0gA+QEEVcys
++TIxxHWVBqB/0Y0n3bOppHKH/lmLmnp0Ft0WpWIp6zqW3IunaFnT63eROfjXy9mPX1onAX1daBli
+2MjN9LdyR75bl87yraKZk62Uy5P2EgmVtqvXO9A/EcswFi55gORngS1d7XB4tmBZrOFdRWOPyN9y
+aFvqHbgB8X7754qz41SgOAngPN5C8sLtLpvzHzW2NtjjgKGLzZlkD8Kqq7HK9W+eQ42EVJmzbsAS
+ZthwEPEGNTNDqJwuuhQxzhB/HIbjj9LV+Hfsm6vxL2PZQl/gZ4FkkfGXL/xuJvYz+NO1+MRiqzFR
+JQJ6+N1rZdVtTTDIZbpoFGWsJwt0ivKH
+-----END CERTIFICATE-----
+
+TrustAsia Global Root CA G4
+===========================
+-----BEGIN CERTIFICATE-----
+MIICVTCCAdygAwIBAgIUTyNkuI6XY57GU4HBdk7LKnQV1tcwCgYIKoZIzj0EAwMwWjELMAkGA1UE
+BhMCQ04xJTAjBgNVBAoMHFRydXN0QXNpYSBUZWNobm9sb2dpZXMsIEluYy4xJDAiBgNVBAMMG1Ry
+dXN0QXNpYSBHbG9iYWwgUm9vdCBDQSBHNDAeFw0yMTA1MjAwMjEwMjJaFw00NjA1MTkwMjEwMjJa
+MFoxCzAJBgNVBAYTAkNOMSUwIwYDVQQKDBxUcnVzdEFzaWEgVGVjaG5vbG9naWVzLCBJbmMuMSQw
+IgYDVQQDDBtUcnVzdEFzaWEgR2xvYmFsIFJvb3QgQ0EgRzQwdjAQBgcqhkjOPQIBBgUrgQQAIgNi
+AATxs8045CVD5d4ZCbuBeaIVXxVjAd7Cq92zphtnS4CDr5nLrBfbK5bKfFJV4hrhPVbwLxYI+hW8
+m7tH5j/uqOFMjPXTNvk4XatwmkcN4oFBButJ+bAp3TPsUKV/eSm4IJijYzBhMA8GA1UdEwEB/wQF
+MAMBAf8wHwYDVR0jBBgwFoAUpbtKl86zK3+kMd6Xg1mDpm9xy94wHQYDVR0OBBYEFKW7SpfOsyt/
+pDHel4NZg6ZvccveMA4GA1UdDwEB/wQEAwIBBjAKBggqhkjOPQQDAwNnADBkAjBe8usGzEkxn0AA
+bbd+NvBNEU/zy4k6LHiRUKNbwMp1JvK/kF0LgoxgKJ/GcJpo5PECMFxYDlZ2z1jD1xCMuo6u47xk
+dUfFVZDj/bpV6wfEU6s3qe4hsiFbYI89MvHVI5TWWA==
+-----END CERTIFICATE-----
+
+CommScope Public Trust ECC Root-01
+==================================
+-----BEGIN CERTIFICATE-----
+MIICHTCCAaOgAwIBAgIUQ3CCd89NXTTxyq4yLzf39H91oJ4wCgYIKoZIzj0EAwMwTjELMAkGA1UE
+BhMCVVMxEjAQBgNVBAoMCUNvbW1TY29wZTErMCkGA1UEAwwiQ29tbVNjb3BlIFB1YmxpYyBUcnVz
+dCBFQ0MgUm9vdC0wMTAeFw0yMTA0MjgxNzM1NDNaFw00NjA0MjgxNzM1NDJaME4xCzAJBgNVBAYT
+AlVTMRIwEAYDVQQKDAlDb21tU2NvcGUxKzApBgNVBAMMIkNvbW1TY29wZSBQdWJsaWMgVHJ1c3Qg
+RUNDIFJvb3QtMDEwdjAQBgcqhkjOPQIBBgUrgQQAIgNiAARLNumuV16ocNfQj3Rid8NeeqrltqLx
+eP0CflfdkXmcbLlSiFS8LwS+uM32ENEp7LXQoMPwiXAZu1FlxUOcw5tjnSCDPgYLpkJEhRGnSjot
+6dZoL0hOUysHP029uax3OVejQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMB0G
+A1UdDgQWBBSOB2LAUN3GGQYARnQE9/OufXVNMDAKBggqhkjOPQQDAwNoADBlAjEAnDPfQeMjqEI2
+Jpc1XHvr20v4qotzVRVcrHgpD7oh2MSg2NED3W3ROT3Ek2DS43KyAjB8xX6I01D1HiXo+k515liW
+pDVfG2XqYZpwI7UNo5uSUm9poIyNStDuiw7LR47QjRE=
+-----END CERTIFICATE-----
+
+CommScope Public Trust ECC Root-02
+==================================
+-----BEGIN CERTIFICATE-----
+MIICHDCCAaOgAwIBAgIUKP2ZYEFHpgE6yhR7H+/5aAiDXX0wCgYIKoZIzj0EAwMwTjELMAkGA1UE
+BhMCVVMxEjAQBgNVBAoMCUNvbW1TY29wZTErMCkGA1UEAwwiQ29tbVNjb3BlIFB1YmxpYyBUcnVz
+dCBFQ0MgUm9vdC0wMjAeFw0yMTA0MjgxNzQ0NTRaFw00NjA0MjgxNzQ0NTNaME4xCzAJBgNVBAYT
+AlVTMRIwEAYDVQQKDAlDb21tU2NvcGUxKzApBgNVBAMMIkNvbW1TY29wZSBQdWJsaWMgVHJ1c3Qg
+RUNDIFJvb3QtMDIwdjAQBgcqhkjOPQIBBgUrgQQAIgNiAAR4MIHoYx7l63FRD/cHB8o5mXxO1Q/M
+MDALj2aTPs+9xYa9+bG3tD60B8jzljHz7aRP+KNOjSkVWLjVb3/ubCK1sK9IRQq9qEmUv4RDsNuE
+SgMjGWdqb8FuvAY5N9GIIvejQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMB0G
+A1UdDgQWBBTmGHX/72DehKT1RsfeSlXjMjZ59TAKBggqhkjOPQQDAwNnADBkAjAmc0l6tqvmSfR9
+Uj/UQQSugEODZXW5hYA4O9Zv5JOGq4/nich/m35rChJVYaoR4HkCMHfoMXGsPHED1oQmHhS48zs7
+3u1Z/GtMMH9ZzkXpc2AVmkzw5l4lIhVtwodZ0LKOag==
+-----END CERTIFICATE-----
+
+CommScope Public Trust RSA Root-01
+==================================
+-----BEGIN CERTIFICATE-----
+MIIFbDCCA1SgAwIBAgIUPgNJgXUWdDGOTKvVxZAplsU5EN0wDQYJKoZIhvcNAQELBQAwTjELMAkG
+A1UEBhMCVVMxEjAQBgNVBAoMCUNvbW1TY29wZTErMCkGA1UEAwwiQ29tbVNjb3BlIFB1YmxpYyBU
+cnVzdCBSU0EgUm9vdC0wMTAeFw0yMTA0MjgxNjQ1NTRaFw00NjA0MjgxNjQ1NTNaME4xCzAJBgNV
+BAYTAlVTMRIwEAYDVQQKDAlDb21tU2NvcGUxKzApBgNVBAMMIkNvbW1TY29wZSBQdWJsaWMgVHJ1
+c3QgUlNBIFJvb3QtMDEwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCwSGWjDR1C45Ft
+nYSkYZYSwu3D2iM0GXb26v1VWvZVAVMP8syMl0+5UMuzAURWlv2bKOx7dAvnQmtVzslhsuitQDy6
+uUEKBU8bJoWPQ7VAtYXR1HHcg0Hz9kXHgKKEUJdGzqAMxGBWBB0HW0alDrJLpA6lfO741GIDuZNq
+ihS4cPgugkY4Iw50x2tBt9Apo52AsH53k2NC+zSDO3OjWiE260f6GBfZumbCk6SP/F2krfxQapWs
+vCQz0b2If4b19bJzKo98rwjyGpg/qYFlP8GMicWWMJoKz/TUyDTtnS+8jTiGU+6Xn6myY5QXjQ/c
+Zip8UlF1y5mO6D1cv547KI2DAg+pn3LiLCuz3GaXAEDQpFSOm117RTYm1nJD68/A6g3czhLmfTif
+BSeolz7pUcZsBSjBAg/pGG3svZwG1KdJ9FQFa2ww8esD1eo9anbCyxooSU1/ZOD6K9pzg4H/kQO9
+lLvkuI6cMmPNn7togbGEW682v3fuHX/3SZtS7NJ3Wn2RnU3COS3kuoL4b/JOHg9O5j9ZpSPcPYeo
+KFgo0fEbNttPxP/hjFtyjMcmAyejOQoBqsCyMWCDIqFPEgkBEa801M/XrmLTBQe0MXXgDW1XT2mH
++VepuhX2yFJtocucH+X8eKg1mp9BFM6ltM6UCBwJrVbl2rZJmkrqYxhTnCwuwwIDAQABo0IwQDAP
+BgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUN12mmnQywsL5x6YVEFm4
+5P3luG0wDQYJKoZIhvcNAQELBQADggIBAK+nz97/4L1CjU3lIpbfaOp9TSp90K09FlxD533Ahuh6
+NWPxzIHIxgvoLlI1pKZJkGNRrDSsBTtXAOnTYtPZKdVUvhwQkZyybf5Z/Xn36lbQnmhUQo8mUuJM
+3y+Xpi/SB5io82BdS5pYV4jvguX6r2yBS5KPQJqTRlnLX3gWsWc+QgvfKNmwrZggvkN80V4aCRck
+jXtdlemrwWCrWxhkgPut4AZ9HcpZuPN4KWfGVh2vtrV0KnahP/t1MJ+UXjulYPPLXAziDslg+Mkf
+Foom3ecnf+slpoq9uC02EJqxWE2aaE9gVOX2RhOOiKy8IUISrcZKiX2bwdgt6ZYD9KJ0DLwAHb/W
+NyVntHKLr4W96ioDj8z7PEQkguIBpQtZtjSNMgsSDesnwv1B10A8ckYpwIzqug/xBpMu95yo9GA+
+o/E4Xo4TwbM6l4c/ksp4qRyv0LAbJh6+cOx69TOY6lz/KwsETkPdY34Op054A5U+1C0wlREQKC6/
+oAI+/15Z0wUOlV9TRe9rh9VIzRamloPh37MG88EU26fsHItdkJANclHnYfkUyq+Dj7+vsQpZXdxc
+1+SWrVtgHdqul7I52Qb1dgAT+GhMIbA1xNxVssnBQVocicCMb3SgazNNtQEo/a2tiRc7ppqEvOuM
+6sRxJKi6KfkIsidWNTJf6jn7MZrVGczw
+-----END CERTIFICATE-----
+
+CommScope Public Trust RSA Root-02
+==================================
+-----BEGIN CERTIFICATE-----
+MIIFbDCCA1SgAwIBAgIUVBa/O345lXGN0aoApYYNK496BU4wDQYJKoZIhvcNAQELBQAwTjELMAkG
+A1UEBhMCVVMxEjAQBgNVBAoMCUNvbW1TY29wZTErMCkGA1UEAwwiQ29tbVNjb3BlIFB1YmxpYyBU
+cnVzdCBSU0EgUm9vdC0wMjAeFw0yMTA0MjgxNzE2NDNaFw00NjA0MjgxNzE2NDJaME4xCzAJBgNV
+BAYTAlVTMRIwEAYDVQQKDAlDb21tU2NvcGUxKzApBgNVBAMMIkNvbW1TY29wZSBQdWJsaWMgVHJ1
+c3QgUlNBIFJvb3QtMDIwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDh+g77aAASyE3V
+rCLENQE7xVTlWXZjpX/rwcRqmL0yjReA61260WI9JSMZNRTpf4mnG2I81lDnNJUDMrG0kyI9p+Kx
+7eZ7Ti6Hmw0zdQreqjXnfuU2mKKuJZ6VszKWpCtYHu8//mI0SFHRtI1CrWDaSWqVcN3SAOLMV2MC
+e5bdSZdbkk6V0/nLKR8YSvgBKtJjCW4k6YnS5cciTNxzhkcAqg2Ijq6FfUrpuzNPDlJwnZXjfG2W
+Wy09X6GDRl224yW4fKcZgBzqZUPckXk2LHR88mcGyYnJ27/aaL8j7dxrrSiDeS/sOKUNNwFnJ5rp
+M9kzXzehxfCrPfp4sOcsn/Y+n2Dg70jpkEUeBVF4GiwSLFworA2iI540jwXmojPOEXcT1A6kHkIf
+hs1w/tkuFT0du7jyU1fbzMZ0KZwYszZ1OC4PVKH4kh+Jlk+71O6d6Ts2QrUKOyrUZHk2EOH5kQMr
+eyBUzQ0ZGshBMjTRsJnhkB4BQDa1t/qp5Xd1pCKBXbCL5CcSD1SIxtuFdOa3wNemKfrb3vOTlycE
+VS8KbzfFPROvCgCpLIscgSjX74Yxqa7ybrjKaixUR9gqiC6vwQcQeKwRoi9C8DfF8rhW3Q5iLc4t
+Vn5V8qdE9isy9COoR+jUKgF4z2rDN6ieZdIs5fq6M8EGRPbmz6UNp2YINIos8wIDAQABo0IwQDAP
+BgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUR9DnsSL/nSz12Vdgs7Gx
+cJXvYXowDQYJKoZIhvcNAQELBQADggIBAIZpsU0v6Z9PIpNojuQhmaPORVMbc0RTAIFhzTHjCLqB
+KCh6krm2qMhDnscTJk3C2OVVnJJdUNjCK9v+5qiXz1I6JMNlZFxHMaNlNRPDk7n3+VGXu6TwYofF
+1gbTl4MgqX67tiHCpQ2EAOHyJxCDut0DgdXdaMNmEMjRdrSzbymeAPnCKfWxkxlSaRosTKCL4BWa
+MS/TiJVZbuXEs1DIFAhKm4sTg7GkcrI7djNB3NyqpgdvHSQSn8h2vS/ZjvQs7rfSOBAkNlEv41xd
+gSGn2rtO/+YHqP65DSdsu3BaVXoT6fEqSWnHX4dXTEN5bTpl6TBcQe7rd6VzEojov32u5cSoHw2O
+HG1QAk8mGEPej1WFsQs3BWDJVTkSBKEqz3EWnzZRSb9wO55nnPt7eck5HHisd5FUmrh1CoFSl+Nm
+YWvtPjgelmFV4ZFUjO2MJB+ByRCac5krFk5yAD9UG/iNuovnFNa2RU9g7Jauwy8CTl2dlklyALKr
+dVwPaFsdZcJfMw8eD/A7hvWwTruc9+olBdytoptLFwG+Qt81IR2tq670v64fG9PiO/yzcnMcmyiQ
+iRM9HcEARwmWmjgb3bHPDcK0RPOWlc4yOo80nOAXx17Org3bhzjlP1v9mxnhMUF6cKojawHhRUzN
+lM47ni3niAIi9G7oyOzWPPO5std3eqx7
+-----END CERTIFICATE-----
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/mk-ca-bundle.pl b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/mk-ca-bundle.pl
deleted file mode 100644
index e5a7420c0e..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/mk-ca-bundle.pl
+++ /dev/null
@@ -1,625 +0,0 @@
-#!/usr/bin/env perl
-# ***************************************************************************
-# * _ _ ____ _
-# * Project ___| | | | _ \| |
-# * / __| | | | |_) | |
-# * | (__| |_| | _ <| |___
-# * \___|\___/|_| \_\_____|
-# *
-# * Copyright (C) 1998 - 2021, Daniel Stenberg, <daniel@haxx.se>, et al.
-# *
-# * This software is licensed as described in the file COPYING, which
-# * you should have received as part of this distribution. The terms
-# * are also available at https://curl.se/docs/copyright.html.
-# *
-# * You may opt to use, copy, modify, merge, publish, distribute and/or sell
-# * copies of the Software, and permit persons to whom the Software is
-# * furnished to do so, under the terms of the COPYING file.
-# *
-# * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY OF ANY
-# * KIND, either express or implied.
-# *
-# ***************************************************************************
-# This Perl script creates a fresh ca-bundle.crt file for use with libcurl.
-# It downloads certdata.txt from Mozilla's source tree (see URL below),
-# then parses certdata.txt and extracts CA Root Certificates into PEM format.
-# These are then processed with the OpenSSL commandline tool to produce the
-# final ca-bundle.crt file.
-# The script is based on the parse-certs script written by Roland Krikava.
-# This Perl script works on almost any platform since its only external
-# dependency is the OpenSSL commandline tool for optional text listing.
-# Hacked by Guenter Knauf.
-#
-use Encode;
-use Getopt::Std;
-use MIME::Base64;
-use strict;
-use warnings;
-use vars qw($opt_b $opt_d $opt_f $opt_h $opt_i $opt_k $opt_l $opt_m $opt_n $opt_p $opt_q $opt_s $opt_t $opt_u $opt_v $opt_w);
-use List::Util;
-use Text::Wrap;
-use Time::Local;
-my $MOD_SHA = "Digest::SHA";
-eval "require $MOD_SHA";
-if ($@) {
- $MOD_SHA = "Digest::SHA::PurePerl";
- eval "require $MOD_SHA";
-}
-eval "require LWP::UserAgent";
-
-my %urls = (
- 'nss' =>
- 'https://hg.mozilla.org/projects/nss/raw-file/default/lib/ckfw/builtins/certdata.txt',
- 'central' =>
- 'https://hg.mozilla.org/mozilla-central/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt',
- 'beta' =>
- 'https://hg.mozilla.org/releases/mozilla-beta/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt',
- 'release' =>
- 'https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt',
-);
-
-$opt_d = 'release';
-
-# If the OpenSSL commandline is not in search path you can configure it here!
-my $openssl = 'openssl';
-
-my $version = '1.28';
-
-$opt_w = 76; # default base64 encoded lines length
-
-# default cert types to include in the output (default is to include CAs which may issue SSL server certs)
-my $default_mozilla_trust_purposes = "SERVER_AUTH";
-my $default_mozilla_trust_levels = "TRUSTED_DELEGATOR";
-$opt_p = $default_mozilla_trust_purposes . ":" . $default_mozilla_trust_levels;
-
-my @valid_mozilla_trust_purposes = (
- "DIGITAL_SIGNATURE",
- "NON_REPUDIATION",
- "KEY_ENCIPHERMENT",
- "DATA_ENCIPHERMENT",
- "KEY_AGREEMENT",
- "KEY_CERT_SIGN",
- "CRL_SIGN",
- "SERVER_AUTH",
- "CLIENT_AUTH",
- "CODE_SIGNING",
- "EMAIL_PROTECTION",
- "IPSEC_END_SYSTEM",
- "IPSEC_TUNNEL",
- "IPSEC_USER",
- "TIME_STAMPING",
- "STEP_UP_APPROVED"
-);
-
-my @valid_mozilla_trust_levels = (
- "TRUSTED_DELEGATOR", # CAs
- "NOT_TRUSTED", # Don't trust these certs.
- "MUST_VERIFY_TRUST", # This explicitly tells us that it ISN'T a CA but is otherwise ok. In other words, this should tell the app to ignore any other sources that claim this is a CA.
- "TRUSTED" # This cert is trusted, but only for itself and not for delegates (i.e. it is not a CA).
-);
-
-my $default_signature_algorithms = $opt_s = "MD5";
-
-my @valid_signature_algorithms = (
- "MD5",
- "SHA1",
- "SHA256",
- "SHA384",
- "SHA512"
-);
-
-$0 =~ s@.*(/|\\)@@;
-$Getopt::Std::STANDARD_HELP_VERSION = 1;
-getopts('bd:fhiklmnp:qs:tuvw:');
-
-if(!defined($opt_d)) {
- # to make plain "-d" use not cause warnings, and actually still work
- $opt_d = 'release';
-}
-
-# Use predefined URL or else custom URL specified on command line.
-my $url;
-if(defined($urls{$opt_d})) {
- $url = $urls{$opt_d};
- if(!$opt_k && $url !~ /^https:\/\//i) {
- die "The URL for '$opt_d' is not HTTPS. Use -k to override (insecure).\n";
- }
-}
-else {
- $url = $opt_d;
-}
-
-my $curl = `curl -V`;
-
-if ($opt_i) {
- print ("=" x 78 . "\n");
- print "Script Version : $version\n";
- print "Perl Version : $]\n";
- print "Operating System Name : $^O\n";
- print "Getopt::Std.pm Version : ${Getopt::Std::VERSION}\n";
- print "Encode::Encoding.pm Version : ${Encode::Encoding::VERSION}\n";
- print "MIME::Base64.pm Version : ${MIME::Base64::VERSION}\n";
- print "LWP::UserAgent.pm Version : ${LWP::UserAgent::VERSION}\n" if($LWP::UserAgent::VERSION);
- print "LWP.pm Version : ${LWP::VERSION}\n" if($LWP::VERSION);
- print "Digest::SHA.pm Version : ${Digest::SHA::VERSION}\n" if ($Digest::SHA::VERSION);
- print "Digest::SHA::PurePerl.pm Version : ${Digest::SHA::PurePerl::VERSION}\n" if ($Digest::SHA::PurePerl::VERSION);
- print ("=" x 78 . "\n");
-}
-
-sub warning_message() {
- if ( $opt_d =~ m/^risk$/i ) { # Long Form Warning and Exit
- print "Warning: Use of this script may pose some risk:\n";
- print "\n";
- print " 1) If you use HTTP URLs they are subject to a man in the middle attack\n";
- print " 2) Default to 'release', but more recent updates may be found in other trees\n";
- print " 3) certdata.txt file format may change, lag time to update this script\n";
- print " 4) Generally unwise to blindly trust CAs without manual review & verification\n";
- print " 5) Mozilla apps use additional security checks aren't represented in certdata\n";
- print " 6) Use of this script will make a security engineer grind his teeth and\n";
- print " swear at you. ;)\n";
- exit;
- } else { # Short Form Warning
- print "Warning: Use of this script may pose some risk, -d risk for more details.\n";
- }
-}
-
-sub HELP_MESSAGE() {
- print "Usage:\t${0} [-b] [-d<certdata>] [-f] [-i] [-k] [-l] [-n] [-p<purposes:levels>] [-q] [-s<algorithms>] [-t] [-u] [-v] [-w<l>] [<outputfile>]\n";
- print "\t-b\tbackup an existing version of ca-bundle.crt\n";
- print "\t-d\tspecify Mozilla tree to pull certdata.txt or custom URL\n";
- print "\t\t Valid names are:\n";
- print "\t\t ", join( ", ", map { ( $_ =~ m/$opt_d/ ) ? "$_ (default)" : "$_" } sort keys %urls ), "\n";
- print "\t-f\tforce rebuild even if certdata.txt is current\n";
- print "\t-i\tprint version info about used modules\n";
- print "\t-k\tallow URLs other than HTTPS, enable HTTP fallback (insecure)\n";
- print "\t-l\tprint license info about certdata.txt\n";
- print "\t-m\tinclude meta data in output\n";
- print "\t-n\tno download of certdata.txt (to use existing)\n";
- print wrap("\t","\t\t", "-p\tlist of Mozilla trust purposes and levels for certificates to include in output. Takes the form of a comma separated list of purposes, a colon, and a comma separated list of levels. (default: $default_mozilla_trust_purposes:$default_mozilla_trust_levels)"), "\n";
- print "\t\t Valid purposes are:\n";
- print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_mozilla_trust_purposes ) ), "\n";
- print "\t\t Valid levels are:\n";
- print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_mozilla_trust_levels ) ), "\n";
- print "\t-q\tbe really quiet (no progress output at all)\n";
- print wrap("\t","\t\t", "-s\tcomma separated list of certificate signatures/hashes to output in plain text mode. (default: $default_signature_algorithms)\n");
- print "\t\t Valid signature algorithms are:\n";
- print wrap("\t\t ","\t\t ", join( ", ", "ALL", @valid_signature_algorithms ) ), "\n";
- print "\t-t\tinclude plain text listing of certificates\n";
- print "\t-u\tunlink (remove) certdata.txt after processing\n";
- print "\t-v\tbe verbose and print out processed CAs\n";
- print "\t-w <l>\twrap base64 output lines after <l> chars (default: ${opt_w})\n";
- exit;
-}
-
-sub VERSION_MESSAGE() {
- print "${0} version ${version} running Perl ${]} on ${^O}\n";
-}
-
-warning_message() unless ($opt_q || $url =~ m/^(ht|f)tps:/i );
-HELP_MESSAGE() if ($opt_h);
-
-sub report($@) {
- my $output = shift;
-
- print STDERR $output . "\n" unless $opt_q;
-}
-
-sub is_in_list($@) {
- my $target = shift;
-
- return defined(List::Util::first { $target eq $_ } @_);
-}
-
-# Parses $param_string as a case insensitive comma separated list with optional whitespace
-# validates that only allowed parameters are supplied
-sub parse_csv_param($$@) {
- my $description = shift;
- my $param_string = shift;
- my @valid_values = @_;
-
- my @values = map {
- s/^\s+//; # strip leading spaces
- s/\s+$//; # strip trailing spaces
- uc $_ # return the modified string as upper case
- } split( ',', $param_string );
-
- # Find all values which are not in the list of valid values or "ALL"
- my @invalid = grep { !is_in_list($_,"ALL",@valid_values) } @values;
-
- if ( scalar(@invalid) > 0 ) {
- # Tell the user which parameters were invalid and print the standard help message which will exit
- print "Error: Invalid ", $description, scalar(@invalid) == 1 ? ": " : "s: ", join( ", ", map { "\"$_\"" } @invalid ), "\n";
- HELP_MESSAGE();
- }
-
- @values = @valid_values if ( is_in_list("ALL",@values) );
-
- return @values;
-}
-
-sub sha256 {
- my $result;
- if ($Digest::SHA::VERSION || $Digest::SHA::PurePerl::VERSION) {
- open(FILE, $_[0]) or die "Can't open '$_[0]': $!";
- binmode(FILE);
- $result = $MOD_SHA->new(256)->addfile(*FILE)->hexdigest;
- close(FILE);
- } else {
- # Use OpenSSL command if Perl Digest::SHA modules not available
- $result = `"$openssl" dgst -r -sha256 "$_[0]"`;
- $result =~ s/^([0-9a-f]{64}) .+/$1/is;
- }
- return $result;
-}
-
-
-sub oldhash {
- my $hash = "";
- open(C, "<$_[0]") || return 0;
- while(<C>) {
- chomp;
- if($_ =~ /^\#\# SHA256: (.*)/) {
- $hash = $1;
- last;
- }
- }
- close(C);
- return $hash;
-}
-
-if ( $opt_p !~ m/:/ ) {
- print "Error: Mozilla trust identifier list must include both purposes and levels\n";
- HELP_MESSAGE();
-}
-
-(my $included_mozilla_trust_purposes_string, my $included_mozilla_trust_levels_string) = split( ':', $opt_p );
-my @included_mozilla_trust_purposes = parse_csv_param( "trust purpose", $included_mozilla_trust_purposes_string, @valid_mozilla_trust_purposes );
-my @included_mozilla_trust_levels = parse_csv_param( "trust level", $included_mozilla_trust_levels_string, @valid_mozilla_trust_levels );
-
-my @included_signature_algorithms = parse_csv_param( "signature algorithm", $opt_s, @valid_signature_algorithms );
-
-sub should_output_cert(%) {
- my %trust_purposes_by_level = @_;
-
- foreach my $level (@included_mozilla_trust_levels) {
- # for each level we want to output, see if any of our desired purposes are included
- return 1 if ( defined( List::Util::first { is_in_list( $_, @included_mozilla_trust_purposes ) } @{$trust_purposes_by_level{$level}} ) );
- }
-
- return 0;
-}
-
-my $crt = $ARGV[0] || 'ca-bundle.crt';
-(my $txt = $url) =~ s@(.*/|\?.*)@@g;
-
-my $stdout = $crt eq '-';
-my $resp;
-my $fetched;
-
-my $oldhash = oldhash($crt);
-
-report "SHA256 of old file: $oldhash";
-
-if(!$opt_n) {
- report "Downloading $txt ...";
-
- # If we have an HTTPS URL then use curl
- if($url =~ /^https:\/\//i) {
- if($curl) {
- if($curl =~ /^Protocols:.* https( |$)/m) {
- report "Get certdata with curl!";
- my $proto = !$opt_k ? "--proto =https" : "";
- my $quiet = $opt_q ? "-s" : "";
- my @out = `curl -w %{response_code} $proto $quiet -o "$txt" "$url"`;
- if(!$? && @out && $out[0] == 200) {
- $fetched = 1;
- report "Downloaded $txt";
- }
- else {
- report "Failed downloading via HTTPS with curl";
- if(-e $txt && !unlink($txt)) {
- report "Failed to remove '$txt': $!";
- }
- }
- }
- else {
- report "curl lacks https support";
- }
- }
- else {
- report "curl not found";
- }
- }
-
- # If nothing was fetched then use LWP
- if(!$fetched) {
- if($url =~ /^https:\/\//i) {
- report "Falling back to HTTP";
- $url =~ s/^https:\/\//http:\/\//i;
- }
- if(!$opt_k) {
- report "URLs other than HTTPS are disabled by default, to enable use -k";
- exit 1;
- }
- report "Get certdata with LWP!";
- if(!defined(${LWP::UserAgent::VERSION})) {
- report "LWP is not available (LWP::UserAgent not found)";
- exit 1;
- }
- my $ua = new LWP::UserAgent(agent => "$0/$version");
- $ua->env_proxy();
- $resp = $ua->mirror($url, $txt);
- if($resp && $resp->code eq '304') {
- report "Not modified";
- exit 0 if -e $crt && !$opt_f;
- }
- else {
- $fetched = 1;
- report "Downloaded $txt";
- }
- if(!$resp || $resp->code !~ /^(?:200|304)$/) {
- report "Unable to download latest data: "
- . ($resp? $resp->code . ' - ' . $resp->message : "LWP failed");
- exit 1 if -e $crt || ! -r $txt;
- }
- }
-}
-
-my $filedate = $resp ? $resp->last_modified : (stat($txt))[9];
-my $datesrc = "as of";
-if(!$filedate) {
- # mxr.mozilla.org gave us a time, hg.mozilla.org does not!
- $filedate = time();
- $datesrc="downloaded on";
-}
-
-# get the hash from the download file
-my $newhash= sha256($txt);
-
-if(!$opt_f && $oldhash eq $newhash) {
- report "Downloaded file identical to previous run\'s source file. Exiting";
- if($opt_u && -e $txt && !unlink($txt)) {
- report "Failed to remove $txt: $!\n";
- }
- exit;
-}
-
-report "SHA256 of new file: $newhash";
-
-my $currentdate = scalar gmtime($filedate);
-
-my $format = $opt_t ? "plain text and " : "";
-if( $stdout ) {
- open(CRT, '> -') or die "Couldn't open STDOUT: $!\n";
-} else {
- open(CRT,">$crt.~") or die "Couldn't open $crt.~: $!\n";
-}
-print CRT <<EOT;
-##
-## Bundle of CA Root Certificates
-##
-## Certificate data from Mozilla ${datesrc}: ${currentdate} GMT
-##
-## This is a bundle of X.509 certificates of public Certificate Authorities
-## (CA). These were automatically extracted from Mozilla's root certificates
-## file (certdata.txt). This file can be found in the mozilla source tree:
-## ${url}
-##
-## It contains the certificates in ${format}PEM format and therefore
-## can be directly used with curl / libcurl / php_curl, or with
-## an Apache+mod_ssl webserver for SSL client authentication.
-## Just configure this file as the SSLCACertificateFile.
-##
-## Conversion done with mk-ca-bundle.pl version $version.
-## SHA256: $newhash
-##
-
-EOT
-
-report "Processing '$txt' ...";
-my $caname;
-my $certnum = 0;
-my $skipnum = 0;
-my $start_of_cert = 0;
-my @precert;
-my $cka_value;
-my $valid = 1;
-
-open(TXT,"$txt") or die "Couldn't open $txt: $!\n";
-while (<TXT>) {
- if (/\*\*\*\*\* BEGIN LICENSE BLOCK \*\*\*\*\*/) {
- print CRT;
- print if ($opt_l);
- while (<TXT>) {
- print CRT;
- print if ($opt_l);
- last if (/\*\*\*\*\* END LICENSE BLOCK \*\*\*\*\*/);
- }
- }
-# Not Valid After : Thu Sep 30 14:01:15 2021
- elsif(/^# Not Valid After : (.*)/) {
- my $stamp = $1;
- use Time::Piece;
- my $t = Time::Piece->strptime
- ($stamp, "%a %b %d %H:%M:%S %Y");
- my $delta = ($t->epoch - time()); # negative means no longer valid
- if($delta < 0) {
- $skipnum++;
- report "Skipping: $caname is not valid anymore" if ($opt_v);
- $valid = 0;
- }
- else {
- $valid = 1;
- }
- next;
- }
- elsif(/^# (Issuer|Serial Number|Subject|Not Valid Before|Fingerprint \(MD5\)|Fingerprint \(SHA1\)):/) {
- push @precert, $_;
- next;
- }
- elsif(/^#|^\s*$/) {
- undef @precert;
- next;
- }
- chomp;
-
- # Example:
- # CKA_NSS_SERVER_DISTRUST_AFTER MULTILINE_OCTAL
- # \062\060\060\066\061\067\060\060\060\060\060\060\132
- # END
-
- if (/^CKA_NSS_SERVER_DISTRUST_AFTER (CK_BBOOL CK_FALSE|MULTILINE_OCTAL)/) {
- if($1 eq "MULTILINE_OCTAL") {
- my @timestamp;
- while (<TXT>) {
- last if (/^END/);
- chomp;
- my @octets = split(/\\/);
- shift @octets;
- for (@octets) {
- push @timestamp, chr(oct);
- }
- }
- # A trailing Z in the timestamp signifies UTC
- if($timestamp[12] ne "Z") {
- report "distrust date stamp is not using UTC";
- }
- # Example date: 200617000000Z
- # Means 2020-06-17 00:00:00 UTC
- my $distrustat =
- timegm($timestamp[10] . $timestamp[11], # second
- $timestamp[8] . $timestamp[9], # minute
- $timestamp[6] . $timestamp[7], # hour
- $timestamp[4] . $timestamp[5], # day
- ($timestamp[2] . $timestamp[3]) - 1, # month
- "20" . $timestamp[0] . $timestamp[1]); # year
- if(time >= $distrustat) {
- # not trusted anymore
- $skipnum++;
- report "Skipping: $caname is not trusted anymore" if ($opt_v);
- $valid = 0;
- }
- else {
- # still trusted
- }
- }
- next;
- }
-
- # this is a match for the start of a certificate
- if (/^CKA_CLASS CK_OBJECT_CLASS CKO_CERTIFICATE/) {
- $start_of_cert = 1
- }
- if ($start_of_cert && /^CKA_LABEL UTF8 \"(.*)\"/) {
- $caname = $1;
- }
- my %trust_purposes_by_level;
- if ($start_of_cert && /^CKA_VALUE MULTILINE_OCTAL/) {
- $cka_value="";
- while (<TXT>) {
- last if (/^END/);
- chomp;
- my @octets = split(/\\/);
- shift @octets;
- for (@octets) {
- $cka_value .= chr(oct);
- }
- }
- }
- if(/^CKA_CLASS CK_OBJECT_CLASS CKO_NSS_TRUST/ && $valid) {
- # now scan the trust part to determine how we should trust this cert
- while (<TXT>) {
- last if (/^#/);
- if (/^CKA_TRUST_([A-Z_]+)\s+CK_TRUST\s+CKT_NSS_([A-Z_]+)\s*$/) {
- if ( !is_in_list($1,@valid_mozilla_trust_purposes) ) {
- report "Warning: Unrecognized trust purpose for cert: $caname. Trust purpose: $1. Trust Level: $2";
- } elsif ( !is_in_list($2,@valid_mozilla_trust_levels) ) {
- report "Warning: Unrecognized trust level for cert: $caname. Trust purpose: $1. Trust Level: $2";
- } else {
- push @{$trust_purposes_by_level{$2}}, $1;
- }
- }
- }
-
- if ( !should_output_cert(%trust_purposes_by_level) ) {
- $skipnum ++;
- report "Skipping: $caname" if ($opt_v);
- } else {
- my $data = $cka_value;
- $cka_value = "";
-
- if(!length($data)) {
- # if empty, skip
- next;
- }
- my $encoded = MIME::Base64::encode_base64($data, '');
- $encoded =~ s/(.{1,${opt_w}})/$1\n/g;
- my $pem = "-----BEGIN CERTIFICATE-----\n"
- . $encoded
- . "-----END CERTIFICATE-----\n";
- print CRT "\n$caname\n";
- print CRT @precert if($opt_m);
- my $maxStringLength = length(decode('UTF-8', $caname, Encode::FB_CROAK | Encode::LEAVE_SRC));
- if ($opt_t) {
- foreach my $key (sort keys %trust_purposes_by_level) {
- my $string = $key . ": " . join(", ", @{$trust_purposes_by_level{$key}});
- $maxStringLength = List::Util::max( length($string), $maxStringLength );
- print CRT $string . "\n";
- }
- }
- print CRT ("=" x $maxStringLength . "\n");
- if (!$opt_t) {
- print CRT $pem;
- } else {
- my $pipe = "";
- foreach my $hash (@included_signature_algorithms) {
- $pipe = "|$openssl x509 -" . $hash . " -fingerprint -noout -inform PEM";
- if (!$stdout) {
- $pipe .= " >> $crt.~";
- close(CRT) or die "Couldn't close $crt.~: $!";
- }
- open(TMP, $pipe) or die "Couldn't open openssl pipe: $!";
- print TMP $pem;
- close(TMP) or die "Couldn't close openssl pipe: $!";
- if (!$stdout) {
- open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!";
- }
- }
- $pipe = "|$openssl x509 -text -inform PEM";
- if (!$stdout) {
- $pipe .= " >> $crt.~";
- close(CRT) or die "Couldn't close $crt.~: $!";
- }
- open(TMP, $pipe) or die "Couldn't open openssl pipe: $!";
- print TMP $pem;
- close(TMP) or die "Couldn't close openssl pipe: $!";
- if (!$stdout) {
- open(CRT, ">>$crt.~") or die "Couldn't open $crt.~: $!";
- }
- }
- report "Parsing: $caname" if ($opt_v);
- $certnum ++;
- $start_of_cert = 0;
- }
- undef @precert;
- }
-
-}
-close(TXT) or die "Couldn't close $txt: $!\n";
-close(CRT) or die "Couldn't close $crt.~: $!\n";
-unless( $stdout ) {
- if ($opt_b && -e $crt) {
- my $bk = 1;
- while (-e "$crt.~${bk}~") {
- $bk++;
- }
- rename $crt, "$crt.~${bk}~" or die "Failed to create backup $crt.~$bk}~: $!\n";
- } elsif( -e $crt ) {
- unlink( $crt ) or die "Failed to remove $crt: $!\n";
- }
- rename "$crt.~", $crt or die "Failed to rename $crt.~ to $crt: $!\n";
-}
-if($opt_u && -e $txt && !unlink($txt)) {
- report "Failed to remove $txt: $!\n";
-}
-report "Done ($certnum CA certs processed, $skipnum skipped).";
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP.pm
index c28f8bf95b..0f6fef8f2c 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP.pm
@@ -1,5 +1,5 @@
package Net::HTTP;
-our $VERSION = '6.22';
+our $VERSION = '6.23';
use strict;
use warnings;
@@ -50,7 +50,7 @@ Net::HTTP - Low-level HTTP connection (client)
=head1 VERSION
-version 6.22
+version 6.23
=head1 SYNOPSIS
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/Methods.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/Methods.pm
index 940cdbccb2..69f4f014d0 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/Methods.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/Methods.pm
@@ -1,5 +1,5 @@
package Net::HTTP::Methods;
-our $VERSION = '6.22';
+our $VERSION = '6.23';
use strict;
use warnings;
use URI;
@@ -655,7 +655,7 @@ Net::HTTP::Methods - Methods shared by Net::HTTP and Net::HTTPS
=head1 VERSION
-version 6.22
+version 6.23
=head1 AUTHOR
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm
index 52d5bc81bf..c3292d8544 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm
@@ -1,5 +1,5 @@
package Net::HTTP::NB;
-our $VERSION = '6.22';
+our $VERSION = '6.23';
use strict;
use warnings;
@@ -60,7 +60,7 @@ Net::HTTP::NB - Non-blocking HTTP client
=head1 VERSION
-version 6.22
+version 6.23
=head1 SYNOPSIS
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm
index 4d58326253..08c3583598 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm
@@ -1,5 +1,5 @@
package Net::HTTPS;
-our $VERSION = '6.22';
+our $VERSION = '6.23';
use strict;
use warnings;
@@ -90,7 +90,7 @@ Net::HTTPS - Low-level HTTP over SSL/TLS connection (client)
=head1 VERSION
-version 6.22
+version 6.23
=head1 DESCRIPTION
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Socket.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Socket.pm
new file mode 100755
index 0000000000..81a99f8fce
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Socket.pm
@@ -0,0 +1,1143 @@
+package Socket;
+
+use v5.6.1;
+use strict;
+
+our $VERSION = '2.037';
+
+=head1 NAME
+
+C<Socket> - networking constants and support functions
+
+=head1 SYNOPSIS
+
+C<Socket> a low-level module used by, among other things, the L<IO::Socket>
+family of modules. The following examples demonstrate some low-level uses but
+a practical program would likely use the higher-level API provided by
+C<IO::Socket> or similar instead.
+
+ use Socket qw(PF_INET SOCK_STREAM pack_sockaddr_in inet_aton);
+
+ socket(my $socket, PF_INET, SOCK_STREAM, 0)
+ or die "socket: $!";
+
+ my $port = getservbyname "echo", "tcp";
+ connect($socket, pack_sockaddr_in($port, inet_aton("localhost")))
+ or die "connect: $!";
+
+ print $socket "Hello, world!\n";
+ print <$socket>;
+
+See also the L</EXAMPLES> section.
+
+=head1 DESCRIPTION
+
+This module provides a variety of constants, structure manipulators and other
+functions related to socket-based networking. The values and functions
+provided are useful when used in conjunction with Perl core functions such as
+socket(), setsockopt() and bind(). It also provides several other support
+functions, mostly for dealing with conversions of network addresses between
+human-readable and native binary forms, and for hostname resolver operations.
+
+Some constants and functions are exported by default by this module; but for
+backward-compatibility any recently-added symbols are not exported by default
+and must be requested explicitly. When an import list is provided to the
+C<use Socket> line, the default exports are not automatically imported. It is
+therefore best practice to always to explicitly list all the symbols required.
+
+Also, some common socket "newline" constants are provided: the constants
+C<CR>, C<LF>, and C<CRLF>, as well as C<$CR>, C<$LF>, and C<$CRLF>, which map
+to C<\015>, C<\012>, and C<\015\012>. If you do not want to use the literal
+characters in your programs, then use the constants provided here. They are
+not exported by default, but can be imported individually, and with the
+C<:crlf> export tag:
+
+ use Socket qw(:DEFAULT :crlf);
+
+ $sock->print("GET / HTTP/1.0$CRLF");
+
+The entire getaddrinfo() subsystem can be exported using the tag C<:addrinfo>;
+this exports the getaddrinfo() and getnameinfo() functions, and all the
+C<AI_*>, C<NI_*>, C<NIx_*> and C<EAI_*> constants.
+
+=cut
+
+=head1 CONSTANTS
+
+In each of the following groups, there may be many more constants provided
+than just the ones given as examples in the section heading. If the heading
+ends C<...> then this means there are likely more; the exact constants
+provided will depend on the OS and headers found at compile-time.
+
+=cut
+
+=head2 PF_INET, PF_INET6, PF_UNIX, ...
+
+Protocol family constants to use as the first argument to socket() or the
+value of the C<SO_DOMAIN> or C<SO_FAMILY> socket option.
+
+=head2 AF_INET, AF_INET6, AF_UNIX, ...
+
+Address family constants used by the socket address structures, to pass to
+such functions as inet_pton() or getaddrinfo(), or are returned by such
+functions as sockaddr_family().
+
+=head2 SOCK_STREAM, SOCK_DGRAM, SOCK_RAW, ...
+
+Socket type constants to use as the second argument to socket(), or the value
+of the C<SO_TYPE> socket option.
+
+=head2 SOCK_NONBLOCK. SOCK_CLOEXEC
+
+Linux-specific shortcuts to specify the C<O_NONBLOCK> and C<FD_CLOEXEC> flags
+during a C<socket(2)> call.
+
+ socket( my $sockh, PF_INET, SOCK_DGRAM|SOCK_NONBLOCK, 0 )
+
+=head2 SOL_SOCKET
+
+Socket option level constant for setsockopt() and getsockopt().
+
+=head2 SO_ACCEPTCONN, SO_BROADCAST, SO_ERROR, ...
+
+Socket option name constants for setsockopt() and getsockopt() at the
+C<SOL_SOCKET> level.
+
+=head2 IP_OPTIONS, IP_TOS, IP_TTL, ...
+
+Socket option name constants for IPv4 socket options at the C<IPPROTO_IP>
+level.
+
+=head2 IP_PMTUDISC_WANT, IP_PMTUDISC_DONT, ...
+
+Socket option value constants for C<IP_MTU_DISCOVER> socket option.
+
+=head2 IPTOS_LOWDELAY, IPTOS_THROUGHPUT, IPTOS_RELIABILITY, ...
+
+Socket option value constants for C<IP_TOS> socket option.
+
+=head2 MSG_BCAST, MSG_OOB, MSG_TRUNC, ...
+
+Message flag constants for send() and recv().
+
+=head2 SHUT_RD, SHUT_RDWR, SHUT_WR
+
+Direction constants for shutdown().
+
+=head2 INADDR_ANY, INADDR_BROADCAST, INADDR_LOOPBACK, INADDR_NONE
+
+Constants giving the special C<AF_INET> addresses for wildcard, broadcast,
+local loopback, and invalid addresses.
+
+Normally equivalent to inet_aton('0.0.0.0'), inet_aton('255.255.255.255'),
+inet_aton('localhost') and inet_aton('255.255.255.255') respectively.
+
+=head2 IPPROTO_IP, IPPROTO_IPV6, IPPROTO_TCP, ...
+
+IP protocol constants to use as the third argument to socket(), the level
+argument to getsockopt() or setsockopt(), or the value of the C<SO_PROTOCOL>
+socket option.
+
+=head2 TCP_CORK, TCP_KEEPALIVE, TCP_NODELAY, ...
+
+Socket option name constants for TCP socket options at the C<IPPROTO_TCP>
+level.
+
+=head2 IN6ADDR_ANY, IN6ADDR_LOOPBACK
+
+Constants giving the special C<AF_INET6> addresses for wildcard and local
+loopback.
+
+Normally equivalent to inet_pton(AF_INET6, "::") and
+inet_pton(AF_INET6, "::1") respectively.
+
+=head2 IPV6_ADD_MEMBERSHIP, IPV6_MTU, IPV6_V6ONLY, ...
+
+Socket option name constants for IPv6 socket options at the C<IPPROTO_IPV6>
+level.
+
+=cut
+
+# Still undocumented: SCM_*, SOMAXCONN, IOV_MAX, UIO_MAXIOV
+
+=head1 STRUCTURE MANIPULATORS
+
+The following functions convert between lists of Perl values and packed binary
+strings representing structures.
+
+=cut
+
+=head2 $family = sockaddr_family $sockaddr
+
+Takes a packed socket address (as returned by pack_sockaddr_in(),
+pack_sockaddr_un() or the perl builtin functions getsockname() and
+getpeername()). Returns the address family tag. This will be one of the
+C<AF_*> constants, such as C<AF_INET> for a C<sockaddr_in> addresses or
+C<AF_UNIX> for a C<sockaddr_un>. It can be used to figure out what unpack to
+use for a sockaddr of unknown type.
+
+=head2 $sockaddr = pack_sockaddr_in $port, $ip_address
+
+Takes two arguments, a port number and an opaque string (as returned by
+inet_aton(), or a v-string). Returns the C<sockaddr_in> structure with those
+arguments packed in and C<AF_INET> filled in. For Internet domain sockets,
+this structure is normally what you need for the arguments in bind(),
+connect(), and send().
+
+An undefined $port argument is taken as zero; an undefined $ip_address is
+considered a fatal error.
+
+=head2 ($port, $ip_address) = unpack_sockaddr_in $sockaddr
+
+Takes a C<sockaddr_in> structure (as returned by pack_sockaddr_in(),
+getpeername() or recv()). Returns a list of two elements: the port and an
+opaque string representing the IP address (you can use inet_ntoa() to convert
+the address to the four-dotted numeric format). Will croak if the structure
+does not represent an C<AF_INET> address.
+
+In scalar context will return just the IP address.
+
+=head2 $sockaddr = sockaddr_in $port, $ip_address
+
+=head2 ($port, $ip_address) = sockaddr_in $sockaddr
+
+A wrapper of pack_sockaddr_in() or unpack_sockaddr_in(). In list context,
+unpacks its argument and returns a list consisting of the port and IP address.
+In scalar context, packs its port and IP address arguments as a C<sockaddr_in>
+and returns it.
+
+Provided largely for legacy compatibility; it is better to use
+pack_sockaddr_in() or unpack_sockaddr_in() explicitly.
+
+=head2 $sockaddr = pack_sockaddr_in6 $port, $ip6_address, [$scope_id, [$flowinfo]]
+
+Takes two to four arguments, a port number, an opaque string (as returned by
+inet_pton()), optionally a scope ID number, and optionally a flow label
+number. Returns the C<sockaddr_in6> structure with those arguments packed in
+and C<AF_INET6> filled in. IPv6 equivalent of pack_sockaddr_in().
+
+An undefined $port argument is taken as zero; an undefined $ip6_address is
+considered a fatal error.
+
+=head2 ($port, $ip6_address, $scope_id, $flowinfo) = unpack_sockaddr_in6 $sockaddr
+
+Takes a C<sockaddr_in6> structure. Returns a list of four elements: the port
+number, an opaque string representing the IPv6 address, the scope ID, and the
+flow label. (You can use inet_ntop() to convert the address to the usual
+string format). Will croak if the structure does not represent an C<AF_INET6>
+address.
+
+In scalar context will return just the IP address.
+
+=head2 $sockaddr = sockaddr_in6 $port, $ip6_address, [$scope_id, [$flowinfo]]
+
+=head2 ($port, $ip6_address, $scope_id, $flowinfo) = sockaddr_in6 $sockaddr
+
+A wrapper of pack_sockaddr_in6() or unpack_sockaddr_in6(). In list context,
+unpacks its argument according to unpack_sockaddr_in6(). In scalar context,
+packs its arguments according to pack_sockaddr_in6().
+
+Provided largely for legacy compatibility; it is better to use
+pack_sockaddr_in6() or unpack_sockaddr_in6() explicitly.
+
+=head2 $sockaddr = pack_sockaddr_un $path
+
+Takes one argument, a pathname. Returns the C<sockaddr_un> structure with that
+path packed in with C<AF_UNIX> filled in. For C<PF_UNIX> sockets, this
+structure is normally what you need for the arguments in bind(), connect(),
+and send().
+
+=head2 ($path) = unpack_sockaddr_un $sockaddr
+
+Takes a C<sockaddr_un> structure (as returned by pack_sockaddr_un(),
+getpeername() or recv()). Returns a list of one element: the pathname. Will
+croak if the structure does not represent an C<AF_UNIX> address.
+
+=head2 $sockaddr = sockaddr_un $path
+
+=head2 ($path) = sockaddr_un $sockaddr
+
+A wrapper of pack_sockaddr_un() or unpack_sockaddr_un(). In a list context,
+unpacks its argument and returns a list consisting of the pathname. In a
+scalar context, packs its pathname as a C<sockaddr_un> and returns it.
+
+Provided largely for legacy compatibility; it is better to use
+pack_sockaddr_un() or unpack_sockaddr_un() explicitly.
+
+These are only supported if your system has E<lt>F<sys/un.h>E<gt>.
+
+=head2 $ip_mreq = pack_ip_mreq $multiaddr, $interface
+
+Takes an IPv4 multicast address and optionally an interface address (or
+C<INADDR_ANY>). Returns the C<ip_mreq> structure with those arguments packed
+in. Suitable for use with the C<IP_ADD_MEMBERSHIP> and C<IP_DROP_MEMBERSHIP>
+sockopts.
+
+=head2 ($multiaddr, $interface) = unpack_ip_mreq $ip_mreq
+
+Takes an C<ip_mreq> structure. Returns a list of two elements; the IPv4
+multicast address and interface address.
+
+=head2 $ip_mreq_source = pack_ip_mreq_source $multiaddr, $source, $interface
+
+Takes an IPv4 multicast address, source address, and optionally an interface
+address (or C<INADDR_ANY>). Returns the C<ip_mreq_source> structure with those
+arguments packed in. Suitable for use with the C<IP_ADD_SOURCE_MEMBERSHIP>
+and C<IP_DROP_SOURCE_MEMBERSHIP> sockopts.
+
+=head2 ($multiaddr, $source, $interface) = unpack_ip_mreq_source $ip_mreq
+
+Takes an C<ip_mreq_source> structure. Returns a list of three elements; the
+IPv4 multicast address, source address and interface address.
+
+=head2 $ipv6_mreq = pack_ipv6_mreq $multiaddr6, $ifindex
+
+Takes an IPv6 multicast address and an interface number. Returns the
+C<ipv6_mreq> structure with those arguments packed in. Suitable for use with
+the C<IPV6_ADD_MEMBERSHIP> and C<IPV6_DROP_MEMBERSHIP> sockopts.
+
+=head2 ($multiaddr6, $ifindex) = unpack_ipv6_mreq $ipv6_mreq
+
+Takes an C<ipv6_mreq> structure. Returns a list of two elements; the IPv6
+address and an interface number.
+
+=cut
+
+=head1 FUNCTIONS
+
+=cut
+
+=head2 $ip_address = inet_aton $string
+
+Takes a string giving the name of a host, or a textual representation of an IP
+address and translates that to an packed binary address structure suitable to
+pass to pack_sockaddr_in(). If passed a hostname that cannot be resolved,
+returns C<undef>. For multi-homed hosts (hosts with more than one address),
+the first address found is returned.
+
+For portability do not assume that the result of inet_aton() is 32 bits wide,
+in other words, that it would contain only the IPv4 address in network order.
+
+This IPv4-only function is provided largely for legacy reasons. Newly-written
+code should use getaddrinfo() or inet_pton() instead for IPv6 support.
+
+=head2 $string = inet_ntoa $ip_address
+
+Takes a packed binary address structure such as returned by
+unpack_sockaddr_in() (or a v-string representing the four octets of the IPv4
+address in network order) and translates it into a string of the form
+C<d.d.d.d> where the C<d>s are numbers less than 256 (the normal
+human-readable four dotted number notation for Internet addresses).
+
+This IPv4-only function is provided largely for legacy reasons. Newly-written
+code should use getnameinfo() or inet_ntop() instead for IPv6 support.
+
+=head2 $address = inet_pton $family, $string
+
+Takes an address family (such as C<AF_INET> or C<AF_INET6>) and a string
+containing a textual representation of an address in that family and
+translates that to an packed binary address structure.
+
+See also getaddrinfo() for a more powerful and flexible function to look up
+socket addresses given hostnames or textual addresses.
+
+=head2 $string = inet_ntop $family, $address
+
+Takes an address family and a packed binary address structure and translates
+it into a human-readable textual representation of the address; typically in
+C<d.d.d.d> form for C<AF_INET> or C<hhhh:hhhh::hhhh> form for C<AF_INET6>.
+
+See also getnameinfo() for a more powerful and flexible function to turn
+socket addresses into human-readable textual representations.
+
+=head2 ($err, @result) = getaddrinfo $host, $service, [$hints]
+
+Given both a hostname and service name, this function attempts to resolve the
+host name into a list of network addresses, and the service name into a
+protocol and port number, and then returns a list of address structures
+suitable to connect() to it.
+
+Given just a host name, this function attempts to resolve it to a list of
+network addresses, and then returns a list of address structures giving these
+addresses.
+
+Given just a service name, this function attempts to resolve it to a protocol
+and port number, and then returns a list of address structures that represent
+it suitable to bind() to. This use should be combined with the C<AI_PASSIVE>
+flag; see below.
+
+Given neither name, it generates an error.
+
+If present, $hints should be a reference to a hash, where the following keys
+are recognised:
+
+=over 4
+
+=item flags => INT
+
+A bitfield containing C<AI_*> constants; see below.
+
+=item family => INT
+
+Restrict to only generating addresses in this address family
+
+=item socktype => INT
+
+Restrict to only generating addresses of this socket type
+
+=item protocol => INT
+
+Restrict to only generating addresses for this protocol
+
+=back
+
+The return value will be a list; the first value being an error indication,
+followed by a list of address structures (if no error occurred).
+
+The error value will be a dualvar; comparable to the C<EAI_*> error constants,
+or printable as a human-readable error message string. If no error occurred it
+will be zero numerically and an empty string.
+
+Each value in the results list will be a hash reference containing the following
+fields:
+
+=over 4
+
+=item family => INT
+
+The address family (e.g. C<AF_INET>)
+
+=item socktype => INT
+
+The socket type (e.g. C<SOCK_STREAM>)
+
+=item protocol => INT
+
+The protocol (e.g. C<IPPROTO_TCP>)
+
+=item addr => STRING
+
+The address in a packed string (such as would be returned by
+pack_sockaddr_in())
+
+=item canonname => STRING
+
+The canonical name for the host if the C<AI_CANONNAME> flag was provided, or
+C<undef> otherwise. This field will only be present on the first returned
+address.
+
+=back
+
+The following flag constants are recognised in the $hints hash. Other flag
+constants may exist as provided by the OS.
+
+=over 4
+
+=item AI_PASSIVE
+
+Indicates that this resolution is for a local bind() for a passive (i.e.
+listening) socket, rather than an active (i.e. connecting) socket.
+
+=item AI_CANONNAME
+
+Indicates that the caller wishes the canonical hostname (C<canonname>) field
+of the result to be filled in.
+
+=item AI_NUMERICHOST
+
+Indicates that the caller will pass a numeric address, rather than a hostname,
+and that getaddrinfo() must not perform a resolve operation on this name. This
+flag will prevent a possibly-slow network lookup operation, and instead return
+an error if a hostname is passed.
+
+=back
+
+=head2 ($err, $hostname, $servicename) = getnameinfo $sockaddr, [$flags, [$xflags]]
+
+Given a packed socket address (such as from getsockname(), getpeername(), or
+returned by getaddrinfo() in a C<addr> field), returns the hostname and
+symbolic service name it represents. $flags may be a bitmask of C<NI_*>
+constants, or defaults to 0 if unspecified.
+
+The return value will be a list; the first value being an error condition,
+followed by the hostname and service name.
+
+The error value will be a dualvar; comparable to the C<EAI_*> error constants,
+or printable as a human-readable error message string. The host and service
+names will be plain strings.
+
+The following flag constants are recognised as $flags. Other flag constants may
+exist as provided by the OS.
+
+=over 4
+
+=item NI_NUMERICHOST
+
+Requests that a human-readable string representation of the numeric address be
+returned directly, rather than performing a name resolve operation that may
+convert it into a hostname. This will also avoid potentially-blocking network
+IO.
+
+=item NI_NUMERICSERV
+
+Requests that the port number be returned directly as a number representation
+rather than performing a name resolve operation that may convert it into a
+service name.
+
+=item NI_NAMEREQD
+
+If a name resolve operation fails to provide a name, then this flag will cause
+getnameinfo() to indicate an error, rather than returning the numeric
+representation as a human-readable string.
+
+=item NI_DGRAM
+
+Indicates that the socket address relates to a C<SOCK_DGRAM> socket, for the
+services whose name differs between TCP and UDP protocols.
+
+=back
+
+The following constants may be supplied as $xflags.
+
+=over 4
+
+=item NIx_NOHOST
+
+Indicates that the caller is not interested in the hostname of the result, so
+it does not have to be converted. C<undef> will be returned as the hostname.
+
+=item NIx_NOSERV
+
+Indicates that the caller is not interested in the service name of the result,
+so it does not have to be converted. C<undef> will be returned as the service
+name.
+
+=back
+
+=head1 getaddrinfo() / getnameinfo() ERROR CONSTANTS
+
+The following constants may be returned by getaddrinfo() or getnameinfo().
+Others may be provided by the OS.
+
+=over 4
+
+=item EAI_AGAIN
+
+A temporary failure occurred during name resolution. The operation may be
+successful if it is retried later.
+
+=item EAI_BADFLAGS
+
+The value of the C<flags> hint to getaddrinfo(), or the $flags parameter to
+getnameinfo() contains unrecognised flags.
+
+=item EAI_FAMILY
+
+The C<family> hint to getaddrinfo(), or the family of the socket address
+passed to getnameinfo() is not supported.
+
+=item EAI_NODATA
+
+The host name supplied to getaddrinfo() did not provide any usable address
+data.
+
+=item EAI_NONAME
+
+The host name supplied to getaddrinfo() does not exist, or the address
+supplied to getnameinfo() is not associated with a host name and the
+C<NI_NAMEREQD> flag was supplied.
+
+=item EAI_SERVICE
+
+The service name supplied to getaddrinfo() is not available for the socket
+type given in the $hints.
+
+=back
+
+=cut
+
+=head1 EXAMPLES
+
+=head2 Lookup for connect()
+
+The getaddrinfo() function converts a hostname and a service name into a list
+of structures, each containing a potential way to connect() to the named
+service on the named host.
+
+ use IO::Socket;
+ use Socket qw(SOCK_STREAM getaddrinfo);
+
+ my %hints = (socktype => SOCK_STREAM);
+ my ($err, @res) = getaddrinfo("localhost", "echo", \%hints);
+ die "Cannot getaddrinfo - $err" if $err;
+
+ my $sock;
+
+ foreach my $ai (@res) {
+ my $candidate = IO::Socket->new();
+
+ $candidate->socket($ai->{family}, $ai->{socktype}, $ai->{protocol})
+ or next;
+
+ $candidate->connect($ai->{addr})
+ or next;
+
+ $sock = $candidate;
+ last;
+ }
+
+ die "Cannot connect to localhost:echo" unless $sock;
+
+ $sock->print("Hello, world!\n");
+ print <$sock>;
+
+Because a list of potential candidates is returned, the C<while> loop tries
+each in turn until it finds one that succeeds both the socket() and connect()
+calls.
+
+This function performs the work of the legacy functions gethostbyname(),
+getservbyname(), inet_aton() and pack_sockaddr_in().
+
+In practice this logic is better performed by L<IO::Socket::IP>.
+
+=head2 Making a human-readable string out of an address
+
+The getnameinfo() function converts a socket address, such as returned by
+getsockname() or getpeername(), into a pair of human-readable strings
+representing the address and service name.
+
+ use IO::Socket::IP;
+ use Socket qw(getnameinfo);
+
+ my $server = IO::Socket::IP->new(LocalPort => 12345, Listen => 1) or
+ die "Cannot listen - $@";
+
+ my $socket = $server->accept or die "accept: $!";
+
+ my ($err, $hostname, $servicename) = getnameinfo($socket->peername);
+ die "Cannot getnameinfo - $err" if $err;
+
+ print "The peer is connected from $hostname\n";
+
+Since in this example only the hostname was used, the redundant conversion of
+the port number into a service name may be omitted by passing the
+C<NIx_NOSERV> flag.
+
+ use Socket qw(getnameinfo NIx_NOSERV);
+
+ my ($err, $hostname) = getnameinfo($socket->peername, 0, NIx_NOSERV);
+
+This function performs the work of the legacy functions unpack_sockaddr_in(),
+inet_ntoa(), gethostbyaddr() and getservbyport().
+
+In practice this logic is better performed by L<IO::Socket::IP>.
+
+=head2 Resolving hostnames into IP addresses
+
+To turn a hostname into a human-readable plain IP address use getaddrinfo()
+to turn the hostname into a list of socket structures, then getnameinfo() on
+each one to make it a readable IP address again.
+
+ use Socket qw(:addrinfo SOCK_RAW);
+
+ my ($err, @res) = getaddrinfo($hostname, "", {socktype => SOCK_RAW});
+ die "Cannot getaddrinfo - $err" if $err;
+
+ while( my $ai = shift @res ) {
+ my ($err, $ipaddr) = getnameinfo($ai->{addr}, NI_NUMERICHOST, NIx_NOSERV);
+ die "Cannot getnameinfo - $err" if $err;
+
+ print "$ipaddr\n";
+ }
+
+The C<socktype> hint to getaddrinfo() filters the results to only include one
+socket type and protocol. Without this most OSes return three combinations,
+for C<SOCK_STREAM>, C<SOCK_DGRAM> and C<SOCK_RAW>, resulting in triplicate
+output of addresses. The C<NI_NUMERICHOST> flag to getnameinfo() causes it to
+return a string-formatted plain IP address, rather than reverse resolving it
+back into a hostname.
+
+This combination performs the work of the legacy functions gethostbyname()
+and inet_ntoa().
+
+=head2 Accessing socket options
+
+The many C<SO_*> and other constants provide the socket option names for
+getsockopt() and setsockopt().
+
+ use IO::Socket::INET;
+ use Socket qw(SOL_SOCKET SO_RCVBUF IPPROTO_IP IP_TTL);
+
+ my $socket = IO::Socket::INET->new(LocalPort => 0, Proto => 'udp')
+ or die "Cannot create socket: $@";
+
+ $socket->setsockopt(SOL_SOCKET, SO_RCVBUF, 64*1024) or
+ die "setsockopt: $!";
+
+ print "Receive buffer is ", $socket->getsockopt(SOL_SOCKET, SO_RCVBUF),
+ " bytes\n";
+
+ print "IP TTL is ", $socket->getsockopt(IPPROTO_IP, IP_TTL), "\n";
+
+As a convenience, L<IO::Socket>'s setsockopt() method will convert a number
+into a packed byte buffer, and getsockopt() will unpack a byte buffer of the
+correct size back into a number.
+
+=cut
+
+=head1 AUTHOR
+
+This module was originally maintained in Perl core by the Perl 5 Porters.
+
+It was extracted to dual-life on CPAN at version 1.95 by
+Paul Evans <leonerd@leonerd.org.uk>
+
+=cut
+
+use Carp;
+use warnings::register;
+
+require Exporter;
+require XSLoader;
+our @ISA = qw(Exporter);
+
+# <@Nicholas> you can't change @EXPORT without breaking the implicit API
+# Please put any new constants in @EXPORT_OK!
+
+# List re-ordered to match documentation above. Try to keep the ordering
+# consistent so it's easier to see which ones are or aren't documented.
+our @EXPORT = qw(
+ PF_802 PF_AAL PF_APPLETALK PF_CCITT PF_CHAOS PF_CTF PF_DATAKIT
+ PF_DECnet PF_DLI PF_ECMA PF_GOSIP PF_HYLINK PF_IMPLINK PF_INET PF_INET6
+ PF_ISO PF_KEY PF_LAST PF_LAT PF_LINK PF_MAX PF_NBS PF_NIT PF_NS PF_OSI
+ PF_OSINET PF_PUP PF_ROUTE PF_SNA PF_UNIX PF_UNSPEC PF_USER PF_WAN
+ PF_X25
+
+ AF_802 AF_AAL AF_APPLETALK AF_CCITT AF_CHAOS AF_CTF AF_DATAKIT
+ AF_DECnet AF_DLI AF_ECMA AF_GOSIP AF_HYLINK AF_IMPLINK AF_INET AF_INET6
+ AF_ISO AF_KEY AF_LAST AF_LAT AF_LINK AF_MAX AF_NBS AF_NIT AF_NS AF_OSI
+ AF_OSINET AF_PUP AF_ROUTE AF_SNA AF_UNIX AF_UNSPEC AF_USER AF_WAN
+ AF_X25
+
+ SOCK_DGRAM SOCK_RAW SOCK_RDM SOCK_SEQPACKET SOCK_STREAM
+
+ SOL_SOCKET
+
+ SO_ACCEPTCONN SO_ATTACH_FILTER SO_BACKLOG SO_BROADCAST SO_CHAMELEON
+ SO_DEBUG SO_DETACH_FILTER SO_DGRAM_ERRIND SO_DOMAIN SO_DONTLINGER
+ SO_DONTROUTE SO_ERROR SO_FAMILY SO_KEEPALIVE SO_LINGER SO_OOBINLINE
+ SO_PASSCRED SO_PASSIFNAME SO_PEERCRED SO_PROTOCOL SO_PROTOTYPE
+ SO_RCVBUF SO_RCVLOWAT SO_RCVTIMEO SO_REUSEADDR SO_REUSEPORT
+ SO_SECURITY_AUTHENTICATION SO_SECURITY_ENCRYPTION_NETWORK
+ SO_SECURITY_ENCRYPTION_TRANSPORT SO_SNDBUF SO_SNDLOWAT SO_SNDTIMEO
+ SO_STATE SO_TYPE SO_USELOOPBACK SO_XOPEN SO_XSE
+
+ IP_HDRINCL IP_OPTIONS IP_RECVOPTS IP_RECVRETOPTS IP_RETOPTS IP_TOS
+ IP_TTL
+
+ MSG_BCAST MSG_BTAG MSG_CTLFLAGS MSG_CTLIGNORE MSG_CTRUNC MSG_DONTROUTE
+ MSG_DONTWAIT MSG_EOF MSG_EOR MSG_ERRQUEUE MSG_ETAG MSG_FASTOPEN MSG_FIN
+ MSG_MAXIOVLEN MSG_MCAST MSG_NOSIGNAL MSG_OOB MSG_PEEK MSG_PROXY MSG_RST
+ MSG_SYN MSG_TRUNC MSG_URG MSG_WAITALL MSG_WIRE
+
+ SHUT_RD SHUT_RDWR SHUT_WR
+
+ INADDR_ANY INADDR_BROADCAST INADDR_LOOPBACK INADDR_NONE
+
+ SCM_CONNECT SCM_CREDENTIALS SCM_CREDS SCM_RIGHTS SCM_TIMESTAMP
+
+ SOMAXCONN
+
+ IOV_MAX
+ UIO_MAXIOV
+
+ sockaddr_family
+ pack_sockaddr_in unpack_sockaddr_in sockaddr_in
+ pack_sockaddr_in6 unpack_sockaddr_in6 sockaddr_in6
+ pack_sockaddr_un unpack_sockaddr_un sockaddr_un
+
+ inet_aton inet_ntoa
+);
+
+# List re-ordered to match documentation above. Try to keep the ordering
+# consistent so it's easier to see which ones are or aren't documented.
+our @EXPORT_OK = qw(
+ CR LF CRLF $CR $LF $CRLF
+
+ SOCK_NONBLOCK SOCK_CLOEXEC
+
+ IP_ADD_MEMBERSHIP IP_ADD_SOURCE_MEMBERSHIP IP_BIND_ADDRESS_NO_PORT
+ IP_DROP_MEMBERSHIP IP_DROP_SOURCE_MEMBERSHIP IP_FREEBIND
+ IP_MULTICAST_ALL IP_MULTICAST_IF IP_MULTICAST_LOOP IP_MULTICAST_TTL
+ IP_MTU IP_MTU_DISCOVER IP_NODEFRAG IP_RECVERR IP_TRANSPARENT
+
+ IPPROTO_IP IPPROTO_IPV6 IPPROTO_RAW IPPROTO_ICMP IPPROTO_IGMP
+ IPPROTO_TCP IPPROTO_UDP IPPROTO_GRE IPPROTO_ESP IPPROTO_AH
+ IPPROTO_ICMPV6 IPPROTO_SCTP
+
+ IP_PMTUDISC_DO IP_PMTUDISC_DONT IP_PMTUDISC_PROBE IP_PMTUDISC_WANT
+
+ IPTOS_LOWDELAY IPTOS_THROUGHPUT IPTOS_RELIABILITY IPTOS_MINCOST
+
+ TCP_CONGESTION TCP_CONNECTIONTIMEOUT TCP_CORK TCP_DEFER_ACCEPT
+ TCP_FASTOPEN TCP_INFO TCP_INIT_CWND TCP_KEEPALIVE TCP_KEEPCNT
+ TCP_KEEPIDLE TCP_KEEPINTVL TCP_LINGER2 TCP_MAXRT TCP_MAXSEG
+ TCP_MD5SIG TCP_NODELAY TCP_NOOPT TCP_NOPUSH TCP_QUICKACK
+ TCP_SACK_ENABLE TCP_STDURG TCP_SYNCNT TCP_USER_TIMEOUT
+ TCP_WINDOW_CLAMP
+
+ IN6ADDR_ANY IN6ADDR_LOOPBACK
+
+ IPV6_ADDRFROM IPV6_ADD_MEMBERSHIP IPV6_DROP_MEMBERSHIP IPV6_JOIN_GROUP
+ IPV6_LEAVE_GROUP IPV6_MTU IPV6_MTU_DISCOVER IPV6_MULTICAST_HOPS
+ IPV6_MULTICAST_IF IPV6_MULTICAST_LOOP IPV6_RECVERR IPV6_ROUTER_ALERT
+ IPV6_UNICAST_HOPS IPV6_V6ONLY
+
+ SO_INCOMING_CPU SO_INCOMING_NAPI_ID SO_LOCK_FILTER SO_RCVBUFFORCE
+ SO_SNDBUFFORCE
+
+ pack_ip_mreq unpack_ip_mreq pack_ip_mreq_source unpack_ip_mreq_source
+
+ pack_ipv6_mreq unpack_ipv6_mreq
+
+ inet_pton inet_ntop
+
+ getaddrinfo getnameinfo
+
+ AI_ADDRCONFIG AI_ALL AI_CANONIDN AI_CANONNAME AI_IDN
+ AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES AI_NUMERICHOST
+ AI_NUMERICSERV AI_PASSIVE AI_V4MAPPED
+
+ NI_DGRAM NI_IDN NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES
+ NI_NAMEREQD NI_NOFQDN NI_NUMERICHOST NI_NUMERICSERV
+
+ NIx_NOHOST NIx_NOSERV
+
+ EAI_ADDRFAMILY EAI_AGAIN EAI_BADFLAGS EAI_BADHINTS EAI_FAIL EAI_FAMILY
+ EAI_NODATA EAI_NONAME EAI_PROTOCOL EAI_SERVICE EAI_SOCKTYPE EAI_SYSTEM
+);
+
+our %EXPORT_TAGS = (
+ crlf => [qw(CR LF CRLF $CR $LF $CRLF)],
+ addrinfo => [qw(getaddrinfo getnameinfo), grep m/^(?:AI|NI|NIx|EAI)_/, @EXPORT_OK],
+ all => [@EXPORT, @EXPORT_OK],
+);
+
+BEGIN {
+ sub CR () {"\015"}
+ sub LF () {"\012"}
+ sub CRLF () {"\015\012"}
+
+ # These are not gni() constants; they're extensions for the perl API
+ # The definitions in Socket.pm and Socket.xs must match
+ sub NIx_NOHOST() {1 << 0}
+ sub NIx_NOSERV() {1 << 1}
+}
+
+*CR = \CR();
+*LF = \LF();
+*CRLF = \CRLF();
+
+# The four deprecated addrinfo constants
+foreach my $name (qw( AI_IDN_ALLOW_UNASSIGNED AI_IDN_USE_STD3_ASCII_RULES NI_IDN_ALLOW_UNASSIGNED NI_IDN_USE_STD3_ASCII_RULES )) {
+ no strict 'refs';
+ *$name = sub {
+ croak "The addrinfo constant $name is deprecated";
+ };
+}
+
+sub sockaddr_in {
+ if (@_ == 6 && !wantarray) { # perl5.001m compat; use this && die
+ my($af, $port, @quad) = @_;
+ warnings::warn "6-ARG sockaddr_in call is deprecated"
+ if warnings::enabled();
+ pack_sockaddr_in($port, inet_aton(join('.', @quad)));
+ } elsif (wantarray) {
+ croak "usage: (port,iaddr) = sockaddr_in(sin_sv)" unless @_ == 1;
+ unpack_sockaddr_in(@_);
+ } else {
+ croak "usage: sin_sv = sockaddr_in(port,iaddr))" unless @_ == 2;
+ pack_sockaddr_in(@_);
+ }
+}
+
+sub sockaddr_in6 {
+ if (wantarray) {
+ croak "usage: (port,in6addr,scope_id,flowinfo) = sockaddr_in6(sin6_sv)" unless @_ == 1;
+ unpack_sockaddr_in6(@_);
+ }
+ else {
+ croak "usage: sin6_sv = sockaddr_in6(port,in6addr,[scope_id,[flowinfo]])" unless @_ >= 2 and @_ <= 4;
+ pack_sockaddr_in6(@_);
+ }
+}
+
+sub sockaddr_un {
+ if (wantarray) {
+ croak "usage: (filename) = sockaddr_un(sun_sv)" unless @_ == 1;
+ unpack_sockaddr_un(@_);
+ } else {
+ croak "usage: sun_sv = sockaddr_un(filename)" unless @_ == 1;
+ pack_sockaddr_un(@_);
+ }
+}
+
+XSLoader::load(__PACKAGE__, $VERSION);
+
+my %errstr;
+
+if( defined &getaddrinfo ) {
+ # These are not part of the API, nothing uses them, and deleting them
+ # reduces the size of %Socket:: by about 12K
+ delete $Socket::{fake_getaddrinfo};
+ delete $Socket::{fake_getnameinfo};
+} else {
+ require Scalar::Util;
+
+ *getaddrinfo = \&fake_getaddrinfo;
+ *getnameinfo = \&fake_getnameinfo;
+
+ # These numbers borrowed from GNU libc's implementation, but since
+ # they're only used by our emulation, it doesn't matter if the real
+ # platform's values differ
+ my %constants = (
+ AI_PASSIVE => 1,
+ AI_CANONNAME => 2,
+ AI_NUMERICHOST => 4,
+ AI_V4MAPPED => 8,
+ AI_ALL => 16,
+ AI_ADDRCONFIG => 32,
+ # RFC 2553 doesn't define this but Linux does - lets be nice and
+ # provide it since we can
+ AI_NUMERICSERV => 1024,
+
+ EAI_BADFLAGS => -1,
+ EAI_NONAME => -2,
+ EAI_NODATA => -5,
+ EAI_FAMILY => -6,
+ EAI_SERVICE => -8,
+
+ NI_NUMERICHOST => 1,
+ NI_NUMERICSERV => 2,
+ NI_NOFQDN => 4,
+ NI_NAMEREQD => 8,
+ NI_DGRAM => 16,
+
+ # Constants we don't support. Export them, but croak if anyone tries to
+ # use them
+ AI_IDN => 64,
+ AI_CANONIDN => 128,
+ NI_IDN => 32,
+
+ # Error constants we'll never return, so it doesn't matter what value
+ # these have, nor that we don't provide strings for them
+ EAI_SYSTEM => -11,
+ EAI_BADHINTS => -1000,
+ EAI_PROTOCOL => -1001
+ );
+
+ foreach my $name ( keys %constants ) {
+ my $value = $constants{$name};
+
+ no strict 'refs';
+ defined &$name or *$name = sub () { $value };
+ }
+
+ %errstr = (
+ # These strings from RFC 2553
+ EAI_BADFLAGS() => "invalid value for ai_flags",
+ EAI_NONAME() => "nodename nor servname provided, or not known",
+ EAI_NODATA() => "no address associated with nodename",
+ EAI_FAMILY() => "ai_family not supported",
+ EAI_SERVICE() => "servname not supported for ai_socktype",
+ );
+}
+
+# The following functions are used if the system does not have a
+# getaddrinfo(3) function in libc; and are used to emulate it for the AF_INET
+# family
+
+# Borrowed from Regexp::Common::net
+my $REGEXP_IPv4_DECIMAL = qr/25[0-5]|2[0-4][0-9]|[0-1]?[0-9]{1,2}/;
+my $REGEXP_IPv4_DOTTEDQUAD = qr/$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL\.$REGEXP_IPv4_DECIMAL/;
+
+sub fake_makeerr
+{
+ my ( $errno ) = @_;
+ my $errstr = $errno == 0 ? "" : ( $errstr{$errno} || $errno );
+ return Scalar::Util::dualvar( $errno, $errstr );
+}
+
+sub fake_getaddrinfo
+{
+ my ( $node, $service, $hints ) = @_;
+
+ $node = "" unless defined $node;
+
+ $service = "" unless defined $service;
+
+ my ( $family, $socktype, $protocol, $flags ) = @$hints{qw( family socktype protocol flags )};
+
+ $family ||= Socket::AF_INET(); # 0 == AF_UNSPEC, which we want too
+ $family == Socket::AF_INET() or return fake_makeerr( EAI_FAMILY() );
+
+ $socktype ||= 0;
+
+ $protocol ||= 0;
+
+ $flags ||= 0;
+
+ my $flag_passive = $flags & AI_PASSIVE(); $flags &= ~AI_PASSIVE();
+ my $flag_canonname = $flags & AI_CANONNAME(); $flags &= ~AI_CANONNAME();
+ my $flag_numerichost = $flags & AI_NUMERICHOST(); $flags &= ~AI_NUMERICHOST();
+ my $flag_numericserv = $flags & AI_NUMERICSERV(); $flags &= ~AI_NUMERICSERV();
+
+ # These constants don't apply to AF_INET-only lookups, so we might as well
+ # just ignore them. For AI_ADDRCONFIG we just presume the host has ability
+ # to talk AF_INET. If not we'd have to return no addresses at all. :)
+ $flags &= ~(AI_V4MAPPED()|AI_ALL()|AI_ADDRCONFIG());
+
+ $flags & (AI_IDN()|AI_CANONIDN()) and
+ croak "Socket::getaddrinfo() does not support IDN";
+
+ $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
+
+ $node eq "" and $service eq "" and return fake_makeerr( EAI_NONAME() );
+
+ my $canonname;
+ my @addrs;
+ if( $node ne "" ) {
+ return fake_makeerr( EAI_NONAME() ) if( $flag_numerichost and $node !~ m/^$REGEXP_IPv4_DOTTEDQUAD$/ );
+ ( $canonname, undef, undef, undef, @addrs ) = gethostbyname( $node );
+ defined $canonname or return fake_makeerr( EAI_NONAME() );
+
+ undef $canonname unless $flag_canonname;
+ }
+ else {
+ $addrs[0] = $flag_passive ? Socket::inet_aton( "0.0.0.0" )
+ : Socket::inet_aton( "127.0.0.1" );
+ }
+
+ my @ports; # Actually ARRAYrefs of [ socktype, protocol, port ]
+ my $protname = "";
+ if( $protocol ) {
+ $protname = eval { getprotobynumber( $protocol ) };
+ }
+
+ if( $service ne "" and $service !~ m/^\d+$/ ) {
+ return fake_makeerr( EAI_NONAME() ) if( $flag_numericserv );
+ getservbyname( $service, $protname ) or return fake_makeerr( EAI_SERVICE() );
+ }
+
+ foreach my $this_socktype ( Socket::SOCK_STREAM(), Socket::SOCK_DGRAM(), Socket::SOCK_RAW() ) {
+ next if $socktype and $this_socktype != $socktype;
+
+ my $this_protname = "raw";
+ $this_socktype == Socket::SOCK_STREAM() and $this_protname = "tcp";
+ $this_socktype == Socket::SOCK_DGRAM() and $this_protname = "udp";
+
+ next if $protname and $this_protname ne $protname;
+
+ my $port;
+ if( $service ne "" ) {
+ if( $service =~ m/^\d+$/ ) {
+ $port = "$service";
+ }
+ else {
+ ( undef, undef, $port, $this_protname ) = getservbyname( $service, $this_protname );
+ next unless defined $port;
+ }
+ }
+ else {
+ $port = 0;
+ }
+
+ push @ports, [ $this_socktype, eval { scalar getprotobyname( $this_protname ) } || 0, $port ];
+ }
+
+ my @ret;
+ foreach my $addr ( @addrs ) {
+ foreach my $portspec ( @ports ) {
+ my ( $socktype, $protocol, $port ) = @$portspec;
+ push @ret, {
+ family => $family,
+ socktype => $socktype,
+ protocol => $protocol,
+ addr => Socket::pack_sockaddr_in( $port, $addr ),
+ canonname => undef,
+ };
+ }
+ }
+
+ # Only supply canonname for the first result
+ if( defined $canonname ) {
+ $ret[0]->{canonname} = $canonname;
+ }
+
+ return ( fake_makeerr( 0 ), @ret );
+}
+
+sub fake_getnameinfo
+{
+ my ( $addr, $flags, $xflags ) = @_;
+
+ my ( $port, $inetaddr );
+ eval { ( $port, $inetaddr ) = Socket::unpack_sockaddr_in( $addr ) }
+ or return fake_makeerr( EAI_FAMILY() );
+
+ my $family = Socket::AF_INET();
+
+ $flags ||= 0;
+
+ my $flag_numerichost = $flags & NI_NUMERICHOST(); $flags &= ~NI_NUMERICHOST();
+ my $flag_numericserv = $flags & NI_NUMERICSERV(); $flags &= ~NI_NUMERICSERV();
+ my $flag_nofqdn = $flags & NI_NOFQDN(); $flags &= ~NI_NOFQDN();
+ my $flag_namereqd = $flags & NI_NAMEREQD(); $flags &= ~NI_NAMEREQD();
+ my $flag_dgram = $flags & NI_DGRAM() ; $flags &= ~NI_DGRAM();
+
+ $flags & NI_IDN() and
+ croak "Socket::getnameinfo() does not support IDN";
+
+ $flags == 0 or return fake_makeerr( EAI_BADFLAGS() );
+
+ $xflags ||= 0;
+
+ my $node;
+ if( $xflags & NIx_NOHOST ) {
+ $node = undef;
+ }
+ elsif( $flag_numerichost ) {
+ $node = Socket::inet_ntoa( $inetaddr );
+ }
+ else {
+ $node = gethostbyaddr( $inetaddr, $family );
+ if( !defined $node ) {
+ return fake_makeerr( EAI_NONAME() ) if $flag_namereqd;
+ $node = Socket::inet_ntoa( $inetaddr );
+ }
+ elsif( $flag_nofqdn ) {
+ my ( $shortname ) = split m/\./, $node;
+ my ( $fqdn ) = gethostbyname $shortname;
+ $node = $shortname if defined $fqdn and $fqdn eq $node;
+ }
+ }
+
+ my $service;
+ if( $xflags & NIx_NOSERV ) {
+ $service = undef;
+ }
+ elsif( $flag_numericserv ) {
+ $service = "$port";
+ }
+ else {
+ my $protname = $flag_dgram ? "udp" : "";
+ $service = getservbyport( $port, $protname );
+ if( !defined $service ) {
+ $service = "$port";
+ }
+ }
+
+ return ( fake_makeerr( 0 ), $node, $service );
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Base.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Base.pm
new file mode 100755
index 0000000000..502ad1d4a4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Base.pm
@@ -0,0 +1,133 @@
+package TAP::Base;
+
+use strict;
+use warnings;
+
+use base 'TAP::Object';
+
+=head1 NAME
+
+TAP::Base - Base class that provides common functionality to L<TAP::Parser>
+and L<TAP::Harness>
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+use constant GOT_TIME_HIRES => do {
+ eval 'use Time::HiRes qw(time);';
+ $@ ? 0 : 1;
+};
+
+=head1 SYNOPSIS
+
+ package TAP::Whatever;
+
+ use base 'TAP::Base';
+
+ # ... later ...
+
+ my $thing = TAP::Whatever->new();
+
+ $thing->callback( event => sub {
+ # do something interesting
+ } );
+
+=head1 DESCRIPTION
+
+C<TAP::Base> provides callback management.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=cut
+
+sub _initialize {
+ my ( $self, $arg_for, $ok_callback ) = @_;
+
+ my %ok_map = map { $_ => 1 } @$ok_callback;
+
+ $self->{ok_callbacks} = \%ok_map;
+
+ if ( my $cb = delete $arg_for->{callbacks} ) {
+ while ( my ( $event, $callback ) = each %$cb ) {
+ $self->callback( $event, $callback );
+ }
+ }
+
+ return $self;
+}
+
+=head3 C<callback>
+
+Install a callback for a named event.
+
+=cut
+
+sub callback {
+ my ( $self, $event, $callback ) = @_;
+
+ my %ok_map = %{ $self->{ok_callbacks} };
+
+ $self->_croak('No callbacks may be installed')
+ unless %ok_map;
+
+ $self->_croak( "Callback $event is not supported. Valid callbacks are "
+ . join( ', ', sort keys %ok_map ) )
+ unless exists $ok_map{$event};
+
+ push @{ $self->{code_for}{$event} }, $callback;
+
+ return;
+}
+
+sub _has_callbacks {
+ my $self = shift;
+ return keys %{ $self->{code_for} } != 0;
+}
+
+sub _callback_for {
+ my ( $self, $event ) = @_;
+ return $self->{code_for}{$event};
+}
+
+sub _make_callback {
+ my $self = shift;
+ my $event = shift;
+
+ my $cb = $self->_callback_for($event);
+ return unless defined $cb;
+ return map { $_->(@_) } @$cb;
+}
+
+=head3 C<get_time>
+
+Return the current time using Time::HiRes if available.
+
+=cut
+
+sub get_time { return time() }
+
+=head3 C<time_is_hires>
+
+Return true if the time returned by get_time is high resolution (i.e. if Time::HiRes is available).
+
+=cut
+
+sub time_is_hires { return GOT_TIME_HIRES }
+
+=head3 C<get_times>
+
+Return array reference of the four-element list of CPU seconds,
+as with L<perlfunc/times>.
+
+=cut
+
+sub get_times { return [ times() ] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Base.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Base.pm
new file mode 100755
index 0000000000..f6efeaed63
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Base.pm
@@ -0,0 +1,490 @@
+package TAP::Formatter::Base;
+
+use strict;
+use warnings;
+use base 'TAP::Base';
+use POSIX qw(strftime);
+
+my $MAX_ERRORS = 5;
+my %VALIDATION_FOR;
+
+BEGIN {
+ %VALIDATION_FOR = (
+ directives => sub { shift; shift },
+ verbosity => sub { shift; shift },
+ normalize => sub { shift; shift },
+ timer => sub { shift; shift },
+ failures => sub { shift; shift },
+ comments => sub { shift; shift },
+ errors => sub { shift; shift },
+ color => sub { shift; shift },
+ jobs => sub { shift; shift },
+ show_count => sub { shift; shift },
+ stdout => sub {
+ my ( $self, $ref ) = @_;
+
+ $self->_croak("option 'stdout' needs a filehandle")
+ unless $self->_is_filehandle($ref);
+
+ return $ref;
+ },
+ );
+
+ sub _is_filehandle {
+ my ( $self, $ref ) = @_;
+
+ return 0 if !defined $ref;
+
+ return 1 if ref $ref eq 'GLOB'; # lexical filehandle
+ return 1 if !ref $ref && ref \$ref eq 'GLOB'; # bare glob like *STDOUT
+
+ return 1 if eval { $ref->can('print') };
+
+ return 0;
+ }
+
+ my @getter_setters = qw(
+ _longest
+ _printed_summary_header
+ _colorizer
+ );
+
+ __PACKAGE__->mk_methods( @getter_setters, keys %VALIDATION_FOR );
+}
+
+=head1 NAME
+
+TAP::Formatter::Base - Base class for harness output delegates
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This provides console orientated output formatting for TAP::Harness.
+
+=head1 SYNOPSIS
+
+ use TAP::Formatter::Console;
+ my $harness = TAP::Formatter::Console->new( \%args );
+
+=cut
+
+sub _initialize {
+ my ( $self, $arg_for ) = @_;
+ $arg_for ||= {};
+
+ $self->SUPER::_initialize($arg_for);
+ my %arg_for = %$arg_for; # force a shallow copy
+
+ $self->verbosity(0);
+
+ for my $name ( keys %VALIDATION_FOR ) {
+ my $property = delete $arg_for{$name};
+ if ( defined $property ) {
+ my $validate = $VALIDATION_FOR{$name};
+ $self->$name( $self->$validate($property) );
+ }
+ }
+
+ if ( my @props = keys %arg_for ) {
+ $self->_croak(
+ "Unknown arguments to " . __PACKAGE__ . "::new (@props)" );
+ }
+
+ $self->stdout( \*STDOUT ) unless $self->stdout;
+
+ if ( $self->color ) {
+ require TAP::Formatter::Color;
+ $self->_colorizer( TAP::Formatter::Color->new );
+ }
+
+ return $self;
+}
+
+sub verbose { shift->verbosity >= 1 }
+sub quiet { shift->verbosity <= -1 }
+sub really_quiet { shift->verbosity <= -2 }
+sub silent { shift->verbosity <= -3 }
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my %args = (
+ verbose => 1,
+ )
+ my $harness = TAP::Formatter::Console->new( \%args );
+
+The constructor returns a new C<TAP::Formatter::Console> object. If
+a L<TAP::Harness> is created with no C<formatter> a
+C<TAP::Formatter::Console> is automatically created. If any of the
+following options were given to TAP::Harness->new they well be passed to
+this constructor which accepts an optional hashref whose allowed keys are:
+
+=over 4
+
+=item * C<verbosity>
+
+Set the verbosity level.
+
+=item * C<verbose>
+
+Printing individual test results to STDOUT.
+
+=item * C<timer>
+
+Append run time for each test to output. Uses L<Time::HiRes> if available.
+
+=item * C<failures>
+
+Show test failures (this is a no-op if C<verbose> is selected).
+
+=item * C<comments>
+
+Show test comments (this is a no-op if C<verbose> is selected).
+
+=item * C<quiet>
+
+Suppressing some test output (mostly failures while tests are running).
+
+=item * C<really_quiet>
+
+Suppressing everything but the tests summary.
+
+=item * C<silent>
+
+Suppressing all output.
+
+=item * C<errors>
+
+If parse errors are found in the TAP output, a note of this will be made
+in the summary report. To see all of the parse errors, set this argument to
+true:
+
+ errors => 1
+
+=item * C<directives>
+
+If set to a true value, only test results with directives will be displayed.
+This overrides other settings such as C<verbose>, C<failures>, or C<comments>.
+
+=item * C<stdout>
+
+A filehandle for catching standard output.
+
+=item * C<color>
+
+If defined specifies whether color output is desired. If C<color> is not
+defined it will default to color output if color support is available on
+the current platform and output is not being redirected.
+
+=item * C<jobs>
+
+The number of concurrent jobs this formatter will handle.
+
+=item * C<show_count>
+
+Boolean value. If false, disables the C<X/Y> test count which shows up while
+tests are running.
+
+=back
+
+Any keys for which the value is C<undef> will be ignored.
+
+=cut
+
+# new supplied by TAP::Base
+
+=head3 C<prepare>
+
+Called by Test::Harness before any test output is generated.
+
+This is an advisory and may not be called in the case where tests are
+being supplied to Test::Harness by an iterator.
+
+=cut
+
+sub prepare {
+ my ( $self, @tests ) = @_;
+
+ my $longest = 0;
+
+ for my $test (@tests) {
+ $longest = length $test if length $test > $longest;
+ }
+
+ $self->_longest($longest);
+}
+
+sub _format_now { strftime "[%H:%M:%S]", localtime }
+
+sub _format_name {
+ my ( $self, $test ) = @_;
+ my $name = $test;
+ my $periods = '.' x ( $self->_longest + 2 - length $test );
+ $periods = " $periods ";
+
+ if ( $self->timer ) {
+ my $stamp = $self->_format_now();
+ return "$stamp $name$periods";
+ }
+ else {
+ return "$name$periods";
+ }
+
+}
+
+=head3 C<open_test>
+
+Called to create a new test session. A test session looks like this:
+
+ my $session = $formatter->open_test( $test, $parser );
+ while ( defined( my $result = $parser->next ) ) {
+ $session->result($result);
+ exit 1 if $result->is_bailout;
+ }
+ $session->close_test;
+
+=cut
+
+sub open_test {
+ die "Unimplemented.";
+}
+
+sub _output_success {
+ my ( $self, $msg ) = @_;
+ $self->_output($msg);
+}
+
+=head3 C<summary>
+
+ $harness->summary( $aggregate );
+
+C<summary> prints the summary report after all tests are run. The first
+argument is an aggregate to summarise. An optional second argument may
+be set to a true value to indicate that the summary is being output as a
+result of an interrupted test run.
+
+=cut
+
+sub summary {
+ my ( $self, $aggregate, $interrupted ) = @_;
+
+ return if $self->silent;
+
+ my @t = $aggregate->descriptions;
+ my $tests = \@t;
+
+ my $runtime = $aggregate->elapsed_timestr;
+
+ my $total = $aggregate->total;
+ my $passed = $aggregate->passed;
+
+ if ( $self->timer ) {
+ $self->_output( $self->_format_now(), "\n" );
+ }
+
+ $self->_failure_output("Test run interrupted!\n")
+ if $interrupted;
+
+ # TODO: Check this condition still works when all subtests pass but
+ # the exit status is nonzero
+
+ if ( $aggregate->all_passed ) {
+ $self->_output_success("All tests successful.\n");
+ }
+
+ # ~TODO option where $aggregate->skipped generates reports
+ if ( $total != $passed or $aggregate->has_problems ) {
+ $self->_output("\nTest Summary Report");
+ $self->_output("\n-------------------\n");
+ for my $test (@$tests) {
+ $self->_printed_summary_header(0);
+ my ($parser) = $aggregate->parsers($test);
+ $self->_output_summary_failure(
+ 'failed',
+ [ ' Failed test: ', ' Failed tests: ' ],
+ $test, $parser
+ );
+ $self->_output_summary_failure(
+ 'todo_passed',
+ " TODO passed: ", $test, $parser
+ );
+
+ # ~TODO this cannot be the default
+ #$self->_output_summary_failure( 'skipped', " Tests skipped: " );
+
+ if ( my $exit = $parser->exit ) {
+ $self->_summary_test_header( $test, $parser );
+ $self->_failure_output(" Non-zero exit status: $exit\n");
+ }
+ elsif ( my $wait = $parser->wait ) {
+ $self->_summary_test_header( $test, $parser );
+ $self->_failure_output(" Non-zero wait status: $wait\n");
+ }
+
+ if ( my @errors = $parser->parse_errors ) {
+ my $explain;
+ if ( @errors > $MAX_ERRORS && !$self->errors ) {
+ $explain
+ = "Displayed the first $MAX_ERRORS of "
+ . scalar(@errors)
+ . " TAP syntax errors.\n"
+ . "Re-run prove with the -p option to see them all.\n";
+ splice @errors, $MAX_ERRORS;
+ }
+ $self->_summary_test_header( $test, $parser );
+ $self->_failure_output(
+ sprintf " Parse errors: %s\n",
+ shift @errors
+ );
+ for my $error (@errors) {
+ my $spaces = ' ' x 16;
+ $self->_failure_output("$spaces$error\n");
+ }
+ $self->_failure_output($explain) if $explain;
+ }
+ }
+ }
+ my $files = @$tests;
+ $self->_output("Files=$files, Tests=$total, $runtime\n");
+ my $status = $aggregate->get_status;
+ $self->_output("Result: $status\n");
+}
+
+sub _output_summary_failure {
+ my ( $self, $method, $name, $test, $parser ) = @_;
+
+ # ugly hack. Must rethink this :(
+ my $output = $method eq 'failed' ? '_failure_output' : '_output';
+
+ if ( my @r = $parser->$method() ) {
+ $self->_summary_test_header( $test, $parser );
+ my ( $singular, $plural )
+ = 'ARRAY' eq ref $name ? @$name : ( $name, $name );
+ $self->$output( @r == 1 ? $singular : $plural );
+ my @results = $self->_balanced_range( 40, @r );
+ $self->$output( sprintf "%s\n" => shift @results );
+ my $spaces = ' ' x 16;
+ while (@results) {
+ $self->$output( sprintf "$spaces%s\n" => shift @results );
+ }
+ }
+}
+
+sub _summary_test_header {
+ my ( $self, $test, $parser ) = @_;
+ return if $self->_printed_summary_header;
+ my $spaces = ' ' x ( $self->_longest - length $test );
+ $spaces = ' ' unless $spaces;
+ my $output = $self->_get_output_method($parser);
+ my $wait = $parser->wait;
+
+ if (defined $wait) {
+ my $signum = $wait & 0x7f;
+
+ my $description;
+
+ if ($signum) {
+ require Config;
+ my @names = split ' ', $Config::Config{'sig_name'};
+ $description = "Signal: $names[$signum]";
+
+ my $dumped = $wait & 0x80;
+ $description .= ', dumped core' if $dumped;
+ }
+ elsif ($wait != 0) {
+ $description = sprintf 'exited %d', ($wait >> 8);
+ }
+
+ $wait .= " ($description)" if $wait != 0;
+ }
+ else {
+ $wait = '(none)';
+ }
+
+ $self->$output(
+ sprintf "$test$spaces(Wstat: %s Tests: %d Failed: %d)\n",
+ $wait, $parser->tests_run, scalar $parser->failed
+ );
+ $self->_printed_summary_header(1);
+}
+
+sub _output {
+ my $self = shift;
+
+ print { $self->stdout } @_;
+}
+
+sub _failure_output {
+ my $self = shift;
+
+ $self->_output(@_);
+}
+
+sub _balanced_range {
+ my ( $self, $limit, @range ) = @_;
+ @range = $self->_range(@range);
+ my $line = "";
+ my @lines;
+ my $curr = 0;
+ while (@range) {
+ if ( $curr < $limit ) {
+ my $range = ( shift @range ) . ", ";
+ $line .= $range;
+ $curr += length $range;
+ }
+ elsif (@range) {
+ $line =~ s/, $//;
+ push @lines => $line;
+ $line = '';
+ $curr = 0;
+ }
+ }
+ if ($line) {
+ $line =~ s/, $//;
+ push @lines => $line;
+ }
+ return @lines;
+}
+
+sub _range {
+ my ( $self, @numbers ) = @_;
+
+ # shouldn't be needed, but subclasses might call this
+ @numbers = sort { $a <=> $b } @numbers;
+ my ( $min, @range );
+
+ for my $i ( 0 .. $#numbers ) {
+ my $num = $numbers[$i];
+ my $next = $numbers[ $i + 1 ];
+ if ( defined $next && $next == $num + 1 ) {
+ if ( !defined $min ) {
+ $min = $num;
+ }
+ }
+ elsif ( defined $min ) {
+ push @range => "$min-$num";
+ undef $min;
+ }
+ else {
+ push @range => $num;
+ }
+ }
+ return @range;
+}
+
+sub _get_output_method {
+ my ( $self, $parser ) = @_;
+ return $parser->has_problems ? '_failure_output' : '_output';
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Color.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Color.pm
new file mode 100755
index 0000000000..873ff9680a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Color.pm
@@ -0,0 +1,116 @@
+package TAP::Formatter::Color;
+
+use strict;
+use warnings;
+
+use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
+
+use base 'TAP::Object';
+
+my $NO_COLOR;
+
+BEGIN {
+ $NO_COLOR = 0;
+
+ eval 'require Term::ANSIColor';
+ if ($@) {
+ $NO_COLOR = $@;
+ };
+ if (IS_WIN32) {
+ eval 'use Win32::Console::ANSI';
+ if ($@) {
+ $NO_COLOR = $@;
+ }
+ };
+
+ if ($NO_COLOR) {
+ *set_color = sub { };
+ } else {
+ *set_color = sub {
+ my ( $self, $output, $color ) = @_;
+ $output->( Term::ANSIColor::color($color) );
+ };
+ }
+}
+
+=head1 NAME
+
+TAP::Formatter::Color - Run Perl test scripts with color
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+Note that this harness is I<experimental>. You may not like the colors I've
+chosen and I haven't yet provided an easy way to override them.
+
+This test harness is the same as L<TAP::Harness>, but test results are output
+in color. Passing tests are printed in green. Failing tests are in red.
+Skipped tests are blue on a white background and TODO tests are printed in
+white.
+
+If L<Term::ANSIColor> cannot be found (and L<Win32::Console::ANSI> if running
+under Windows) tests will be run without color.
+
+=head1 SYNOPSIS
+
+ use TAP::Formatter::Color;
+ my $harness = TAP::Formatter::Color->new( \%args );
+ $harness->runtests(@tests);
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+The constructor returns a new C<TAP::Formatter::Color> object. If
+L<Term::ANSIColor> is not installed, returns undef.
+
+=cut
+
+# new() implementation supplied by TAP::Object
+
+sub _initialize {
+ my $self = shift;
+
+ if ($NO_COLOR) {
+
+ # shorten that message a bit
+ ( my $error = $NO_COLOR ) =~ s/ in \@INC .*//s;
+ warn "Note: Cannot run tests in color: $error\n";
+ return; # abort object construction
+ }
+
+ return $self;
+}
+
+##############################################################################
+
+=head3 C<can_color>
+
+ Test::Formatter::Color->can_color()
+
+Returns a boolean indicating whether or not this module can actually
+generate colored output. This will be false if it could not load the
+modules needed for the current platform.
+
+=cut
+
+sub can_color {
+ return !$NO_COLOR;
+}
+
+=head3 C<set_color>
+
+Set the output color.
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console.pm
new file mode 100755
index 0000000000..dc7e0ddc64
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console.pm
@@ -0,0 +1,100 @@
+package TAP::Formatter::Console;
+
+use strict;
+use warnings;
+use base 'TAP::Formatter::Base';
+use POSIX qw(strftime);
+
+=head1 NAME
+
+TAP::Formatter::Console - Harness output delegate for default console output
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This provides console orientated output formatting for TAP::Harness.
+
+=head1 SYNOPSIS
+
+ use TAP::Formatter::Console;
+ my $harness = TAP::Formatter::Console->new( \%args );
+
+=head2 C<< open_test >>
+
+See L<TAP::Formatter::Base>
+
+=cut
+
+sub open_test {
+ my ( $self, $test, $parser ) = @_;
+
+ my $class
+ = $self->jobs > 1
+ ? 'TAP::Formatter::Console::ParallelSession'
+ : 'TAP::Formatter::Console::Session';
+
+ eval "require $class";
+ $self->_croak($@) if $@;
+
+ my $session = $class->new(
+ { name => $test,
+ formatter => $self,
+ parser => $parser,
+ show_count => $self->show_count,
+ }
+ );
+
+ $session->header;
+
+ return $session;
+}
+
+# Use _colorizer delegate to set output color. NOP if we have no delegate
+sub _set_colors {
+ my ( $self, @colors ) = @_;
+ if ( my $colorizer = $self->_colorizer ) {
+ my $output_func = $self->{_output_func} ||= sub {
+ $self->_output(@_);
+ };
+ $colorizer->set_color( $output_func, $_ ) for @colors;
+ }
+}
+
+sub _failure_color {
+ my ($self) = @_;
+
+ return $ENV{'HARNESS_SUMMARY_COLOR_FAIL'} || 'red';
+}
+
+sub _success_color {
+ my ($self) = @_;
+
+ return $ENV{'HARNESS_SUMMARY_COLOR_SUCCESS'} || 'green';
+}
+
+sub _output_success {
+ my ( $self, $msg ) = @_;
+ $self->_set_colors( $self->_success_color() );
+ $self->_output($msg);
+ $self->_set_colors('reset');
+}
+
+sub _failure_output {
+ my $self = shift;
+ $self->_set_colors( $self->_failure_color() );
+ my $out = join '', @_;
+ my $has_newline = chomp $out;
+ $self->_output($out);
+ $self->_set_colors('reset');
+ $self->_output($/)
+ if $has_newline;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/ParallelSession.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/ParallelSession.pm
new file mode 100755
index 0000000000..1ec9e8be9a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/ParallelSession.pm
@@ -0,0 +1,201 @@
+package TAP::Formatter::Console::ParallelSession;
+
+use strict;
+use warnings;
+use File::Spec;
+use File::Path;
+use Carp;
+
+use base 'TAP::Formatter::Console::Session';
+
+use constant WIDTH => 72; # Because Eric says
+
+my %shared;
+
+sub _initialize {
+ my ( $self, $arg_for ) = @_;
+
+ $self->SUPER::_initialize($arg_for);
+ my $formatter = $self->formatter;
+
+ # Horrid bodge. This creates our shared context per harness. Maybe
+ # TAP::Harness should give us this?
+ my $context = $shared{$formatter} ||= $self->_create_shared_context;
+ push @{ $context->{active} }, $self;
+
+ return $self;
+}
+
+sub _create_shared_context {
+ my $self = shift;
+ return {
+ active => [],
+ tests => 0,
+ fails => 0,
+ };
+}
+
+=head1 NAME
+
+TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel console output
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This provides console orientated output formatting for L<TAP::Harness>
+when run with multiple L<TAP::Harness/jobs>.
+
+=head1 SYNOPSIS
+
+=cut
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<header>
+
+Output test preamble
+
+=cut
+
+sub header {
+}
+
+sub _clear_ruler {
+ my $self = shift;
+ $self->formatter->_output( "\r" . ( ' ' x WIDTH ) . "\r" );
+}
+
+my $now = 0;
+my $start;
+
+my $trailer = '... )===';
+my $chop_length = WIDTH - length $trailer;
+
+sub _output_ruler {
+ my ( $self, $refresh ) = @_;
+ my $new_now = time;
+ return if $new_now == $now and !$refresh;
+ $now = $new_now;
+ $start ||= $now;
+ my $formatter = $self->formatter;
+ return if $formatter->really_quiet;
+
+ my $context = $shared{$formatter};
+
+ my $ruler = sprintf '===( %7d;%d ', $context->{tests}, $now - $start;
+
+ for my $active ( @{ $context->{active} } ) {
+ my $parser = $active->parser;
+ my $tests = $parser->tests_run;
+ my $planned = $parser->tests_planned || '?';
+
+ $ruler .= sprintf '%' . length($planned) . "d/$planned ", $tests;
+ }
+ chop $ruler; # Remove a trailing space
+ $ruler .= ')===';
+
+ if ( length $ruler > WIDTH ) {
+ $ruler =~ s/(.{$chop_length}).*/$1$trailer/o;
+ }
+ else {
+ $ruler .= '=' x ( WIDTH - length($ruler) );
+ }
+ $formatter->_output("\r$ruler");
+}
+
+=head3 C<result>
+
+ Called by the harness for each line of TAP it receives .
+
+=cut
+
+sub result {
+ my ( $self, $result ) = @_;
+ my $formatter = $self->formatter;
+
+ # my $really_quiet = $formatter->really_quiet;
+ # my $show_count = $self->_should_show_count;
+
+ if ( $result->is_test ) {
+ my $context = $shared{$formatter};
+ $context->{tests}++;
+
+ my $active = $context->{active};
+ if ( @$active == 1 ) {
+
+ # There is only one test, so use the serial output format.
+ return $self->SUPER::result($result);
+ }
+
+ $self->_output_ruler( $self->parser->tests_run == 1 );
+ }
+ elsif ( $result->is_bailout ) {
+ $formatter->_failure_output(
+ "Bailout called. Further testing stopped: "
+ . $result->explanation
+ . "\n" );
+ }
+}
+
+=head3 C<clear_for_close>
+
+=cut
+
+sub clear_for_close {
+ my $self = shift;
+ my $formatter = $self->formatter;
+ return if $formatter->really_quiet;
+ my $context = $shared{$formatter};
+ if ( @{ $context->{active} } == 1 ) {
+ $self->SUPER::clear_for_close;
+ }
+ else {
+ $self->_clear_ruler;
+ }
+}
+
+=head3 C<close_test>
+
+=cut
+
+sub close_test {
+ my $self = shift;
+ my $name = $self->name;
+ my $parser = $self->parser;
+ my $formatter = $self->formatter;
+ my $context = $shared{$formatter};
+
+ $self->SUPER::close_test;
+
+ my $active = $context->{active};
+
+ my @pos = grep { $active->[$_]->name eq $name } 0 .. $#$active;
+
+ die "Can't find myself" unless @pos;
+ splice @$active, $pos[0], 1;
+
+ if ( @$active > 1 ) {
+ $self->_output_ruler(1);
+ }
+ elsif ( @$active == 1 ) {
+
+ # Print out "test/name.t ...."
+ $active->[0]->SUPER::header;
+ }
+ else {
+
+ # $self->formatter->_output("\n");
+ delete $shared{$formatter};
+ }
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/Session.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/Session.pm
new file mode 100755
index 0000000000..53ad867387
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Console/Session.pm
@@ -0,0 +1,205 @@
+package TAP::Formatter::Console::Session;
+
+use strict;
+use warnings;
+
+use base 'TAP::Formatter::Session';
+
+my @ACCESSOR;
+
+BEGIN {
+ my @CLOSURE_BINDING = qw( header result clear_for_close close_test );
+
+ for my $method (@CLOSURE_BINDING) {
+ no strict 'refs';
+ *$method = sub {
+ my $self = shift;
+ return ( $self->{_closures} ||= $self->_closures )->{$method}
+ ->(@_);
+ };
+ }
+}
+
+=head1 NAME
+
+TAP::Formatter::Console::Session - Harness output delegate for default console output
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This provides console orientated output formatting for TAP::Harness.
+
+=cut
+
+sub _get_output_result {
+ my $self = shift;
+
+ my @color_map = (
+ { test => sub { $_->is_test && !$_->is_ok },
+ colors => ['red'],
+ },
+ { test => sub { $_->is_test && $_->has_skip },
+ colors => [
+ 'white',
+ 'on_blue'
+ ],
+ },
+ { test => sub { $_->is_test && $_->has_todo },
+ colors => ['yellow'],
+ },
+ );
+
+ my $formatter = $self->formatter;
+ my $parser = $self->parser;
+
+ return $formatter->_colorizer
+ ? sub {
+ my $result = shift;
+ for my $col (@color_map) {
+ local $_ = $result;
+ if ( $col->{test}->() ) {
+ $formatter->_set_colors( @{ $col->{colors} } );
+ last;
+ }
+ }
+ $formatter->_output( $self->_format_for_output($result) );
+ $formatter->_set_colors('reset');
+ }
+ : sub {
+ $formatter->_output( $self->_format_for_output(shift) );
+ };
+}
+
+sub _closures {
+ my $self = shift;
+
+ my $parser = $self->parser;
+ my $formatter = $self->formatter;
+ my $pretty = $formatter->_format_name( $self->name );
+ my $show_count = $self->show_count;
+
+ my $really_quiet = $formatter->really_quiet;
+ my $quiet = $formatter->quiet;
+ my $verbose = $formatter->verbose;
+ my $directives = $formatter->directives;
+ my $failures = $formatter->failures;
+ my $comments = $formatter->comments;
+
+ my $output_result = $self->_get_output_result;
+
+ my $output = '_output';
+ my $plan = '';
+ my $newline_printed = 0;
+
+ my $last_status_printed = 0;
+
+ return {
+ header => sub {
+ $formatter->_output($pretty)
+ unless $really_quiet;
+ },
+
+ result => sub {
+ my $result = shift;
+
+ if ( $result->is_bailout ) {
+ $formatter->_failure_output(
+ "Bailout called. Further testing stopped: "
+ . $result->explanation
+ . "\n" );
+ }
+
+ return if $really_quiet;
+
+ my $is_test = $result->is_test;
+
+ # These are used in close_test - but only if $really_quiet
+ # is false - so it's safe to only set them here unless that
+ # relationship changes.
+
+ if ( !$plan ) {
+ my $planned = $parser->tests_planned || '?';
+ $plan = "/$planned ";
+ }
+ $output = $formatter->_get_output_method($parser);
+
+ if ( $show_count and $is_test ) {
+ my $number = $result->number;
+ my $now = CORE::time;
+
+ # Print status roughly once per second.
+ # We will always get the first number as a side effect of
+ # $last_status_printed starting with the value 0, which $now
+ # will never be. (Unless someone sets their clock to 1970)
+ if ( $last_status_printed != $now ) {
+ $formatter->$output("\r$pretty$number$plan");
+ $last_status_printed = $now;
+ }
+ }
+
+ if (!$quiet
+ && ( $verbose
+ || ( $is_test && $failures && !$result->is_ok )
+ || ( $comments && $result->is_comment )
+ || ( $directives && $result->has_directive ) )
+ )
+ {
+ unless ($newline_printed) {
+ $formatter->_output("\n");
+ $newline_printed = 1;
+ }
+ $output_result->($result);
+ $formatter->_output("\n");
+ }
+ },
+
+ clear_for_close => sub {
+ my $spaces
+ = ' ' x length( '.' . $pretty . $plan . $parser->tests_run );
+ $formatter->$output("\r$spaces");
+ },
+
+ close_test => sub {
+ if ( $show_count && !$really_quiet ) {
+ $self->clear_for_close;
+ $formatter->$output("\r$pretty");
+ }
+
+ # Avoid circular references
+ $self->parser(undef);
+ $self->{_closures} = {};
+
+ return if $really_quiet;
+
+ if ( my $skip_all = $parser->skip_all ) {
+ $formatter->_output("skipped: $skip_all\n");
+ }
+ elsif ( $parser->has_problems ) {
+ $self->_output_test_failure($parser);
+ }
+ else {
+ my $time_report = $self->time_report($formatter, $parser);
+ $formatter->_output_success( $self->_make_ok_line($time_report) );
+ }
+ },
+ };
+}
+
+=head2 C<< clear_for_close >>
+
+=head2 C<< close_test >>
+
+=head2 C<< header >>
+
+=head2 C<< result >>
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File.pm
new file mode 100755
index 0000000000..396b4074b3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File.pm
@@ -0,0 +1,56 @@
+package TAP::Formatter::File;
+
+use strict;
+use warnings;
+use TAP::Formatter::File::Session;
+use POSIX qw(strftime);
+
+use base 'TAP::Formatter::Base';
+
+=head1 NAME
+
+TAP::Formatter::File - Harness output delegate for file output
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This provides file orientated output formatting for TAP::Harness.
+
+=head1 SYNOPSIS
+
+ use TAP::Formatter::File;
+ my $harness = TAP::Formatter::File->new( \%args );
+
+=head2 C<< open_test >>
+
+See L<TAP::Formatter::Base>
+
+=cut
+
+sub open_test {
+ my ( $self, $test, $parser ) = @_;
+
+ my $session = TAP::Formatter::File::Session->new(
+ { name => $test,
+ formatter => $self,
+ parser => $parser,
+ }
+ );
+
+ $session->header;
+
+ return $session;
+}
+
+sub _should_show_count {
+ return 0;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File/Session.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File/Session.pm
new file mode 100755
index 0000000000..210c9a47d3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/File/Session.pm
@@ -0,0 +1,95 @@
+package TAP::Formatter::File::Session;
+
+use strict;
+use warnings;
+use base 'TAP::Formatter::Session';
+
+=head1 NAME
+
+TAP::Formatter::File::Session - Harness output delegate for file output
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This provides file orientated output formatting for L<TAP::Harness>.
+It is particularly important when running with parallel tests, as it
+ensures that test results are not interleaved, even when run
+verbosely.
+
+=cut
+
+=head1 METHODS
+
+=head2 result
+
+Stores results for later output, all together.
+
+=cut
+
+sub result {
+ my $self = shift;
+ my $result = shift;
+
+ my $parser = $self->parser;
+ my $formatter = $self->formatter;
+
+ if ( $result->is_bailout ) {
+ $formatter->_failure_output(
+ "Bailout called. Further testing stopped: "
+ . $result->explanation
+ . "\n" );
+ return;
+ }
+
+ if (!$formatter->quiet
+ && ( $formatter->verbose
+ || ( $result->is_test && $formatter->failures && !$result->is_ok )
+ || ( $formatter->comments && $result->is_comment )
+ || ( $result->has_directive && $formatter->directives ) )
+ )
+ {
+ $self->{results} .= $self->_format_for_output($result) . "\n";
+ }
+}
+
+=head2 close_test
+
+When the test file finishes, outputs the summary, together.
+
+=cut
+
+sub close_test {
+ my $self = shift;
+
+ # Avoid circular references
+ $self->parser(undef);
+
+ my $parser = $self->parser;
+ my $formatter = $self->formatter;
+ my $pretty = $formatter->_format_name( $self->name );
+
+ return if $formatter->really_quiet;
+ if ( my $skip_all = $parser->skip_all ) {
+ $formatter->_output( $pretty . "skipped: $skip_all\n" );
+ }
+ elsif ( $parser->has_problems ) {
+ $formatter->_output(
+ $pretty . ( $self->{results} ? "\n" . $self->{results} : "\n" ) );
+ $self->_output_test_failure($parser);
+ }
+ else {
+ my $time_report = $self->time_report( $formatter, $parser );
+ $formatter->_output(
+ $pretty . ( $self->{results} ? "\n" . $self->{results} : "" ) );
+ $formatter->_output_success( $self->_make_ok_line($time_report) );
+ }
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Session.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Session.pm
new file mode 100755
index 0000000000..5fb633b443
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Formatter/Session.pm
@@ -0,0 +1,220 @@
+package TAP::Formatter::Session;
+
+use strict;
+use warnings;
+
+use base 'TAP::Base';
+
+my @ACCESSOR;
+
+BEGIN {
+
+ @ACCESSOR = qw( name formatter parser show_count );
+
+ for my $method (@ACCESSOR) {
+ no strict 'refs';
+ *$method = sub { shift->{$method} };
+ }
+}
+
+=head1 NAME
+
+TAP::Formatter::Session - Abstract base class for harness output delegate
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my %args = (
+ formatter => $self,
+ )
+ my $harness = TAP::Formatter::Console::Session->new( \%args );
+
+The constructor returns a new C<TAP::Formatter::Console::Session> object.
+
+=over 4
+
+=item * C<formatter>
+
+=item * C<parser>
+
+=item * C<name>
+
+=item * C<show_count>
+
+=back
+
+=cut
+
+sub _initialize {
+ my ( $self, $arg_for ) = @_;
+ $arg_for ||= {};
+
+ $self->SUPER::_initialize($arg_for);
+ my %arg_for = %$arg_for; # force a shallow copy
+
+ for my $name (@ACCESSOR) {
+ $self->{$name} = delete $arg_for{$name};
+ }
+
+ if ( !defined $self->show_count ) {
+ $self->{show_count} = 1; # defaults to true
+ }
+ if ( $self->show_count ) { # but may be a damned lie!
+ $self->{show_count} = $self->_should_show_count;
+ }
+
+ if ( my @props = sort keys %arg_for ) {
+ $self->_croak(
+ "Unknown arguments to " . __PACKAGE__ . "::new (@props)" );
+ }
+
+ return $self;
+}
+
+=head3 C<header>
+
+Output test preamble
+
+=head3 C<result>
+
+Called by the harness for each line of TAP it receives.
+
+=head3 C<close_test>
+
+Called to close a test session.
+
+=head3 C<clear_for_close>
+
+Called by C<close_test> to clear the line showing test progress, or the parallel
+test ruler, prior to printing the final test result.
+
+=head3 C<time_report>
+
+Return a formatted string about the elapsed (wall-clock) time
+and about the consumed CPU time.
+
+=cut
+
+sub header { }
+
+sub result { }
+
+sub close_test { }
+
+sub clear_for_close { }
+
+sub _should_show_count {
+ my $self = shift;
+ return
+ !$self->formatter->verbose
+ && -t $self->formatter->stdout
+ && !$ENV{HARNESS_NOTTY};
+}
+
+sub _format_for_output {
+ my ( $self, $result ) = @_;
+ return $self->formatter->normalize ? $result->as_string : $result->raw;
+}
+
+sub _output_test_failure {
+ my ( $self, $parser ) = @_;
+ my $formatter = $self->formatter;
+ return if $formatter->really_quiet;
+
+ my $tests_run = $parser->tests_run;
+ my $tests_planned = $parser->tests_planned;
+
+ my $total
+ = defined $tests_planned
+ ? $tests_planned
+ : $tests_run;
+
+ my $passed = $parser->passed;
+
+ # The total number of fails includes any tests that were planned but
+ # didn't run
+ my $failed = $parser->failed + $total - $tests_run;
+ my $exit = $parser->exit;
+
+ if ( my $exit = $parser->exit ) {
+ my $wstat = $parser->wait;
+ my $status = sprintf( "%d (wstat %d, 0x%x)", $exit, $wstat, $wstat );
+ $formatter->_failure_output("Dubious, test returned $status\n");
+ }
+
+ if ( $failed == 0 ) {
+ $formatter->_failure_output(
+ $total
+ ? "All $total subtests passed "
+ : 'No subtests run '
+ );
+ }
+ else {
+ $formatter->_failure_output("Failed $failed/$total subtests ");
+ if ( !$total ) {
+ $formatter->_failure_output("\nNo tests run!");
+ }
+ }
+
+ if ( my $skipped = $parser->skipped ) {
+ $passed -= $skipped;
+ my $test = 'subtest' . ( $skipped != 1 ? 's' : '' );
+ $formatter->_output(
+ "\n\t(less $skipped skipped $test: $passed okay)");
+ }
+
+ if ( my $failed = $parser->todo_passed ) {
+ my $test = $failed > 1 ? 'tests' : 'test';
+ $formatter->_output(
+ "\n\t($failed TODO $test unexpectedly succeeded)");
+ }
+
+ $formatter->_output("\n");
+}
+
+sub _make_ok_line {
+ my ( $self, $suffix ) = @_;
+ return "ok$suffix\n";
+}
+
+sub time_report {
+ my ( $self, $formatter, $parser ) = @_;
+
+ my @time_report;
+ if ( $formatter->timer ) {
+ my $start_time = $parser->start_time;
+ my $end_time = $parser->end_time;
+ if ( defined $start_time and defined $end_time ) {
+ my $elapsed = $end_time - $start_time;
+ push @time_report,
+ $self->time_is_hires
+ ? sprintf( ' %8d ms', $elapsed * 1000 )
+ : sprintf( ' %8s s', $elapsed || '<1' );
+ }
+ my $start_times = $parser->start_times();
+ my $end_times = $parser->end_times();
+ my $usr = $end_times->[0] - $start_times->[0];
+ my $sys = $end_times->[1] - $start_times->[1];
+ my $cusr = $end_times->[2] - $start_times->[2];
+ my $csys = $end_times->[3] - $start_times->[3];
+ push @time_report,
+ sprintf('(%5.2f usr %5.2f sys + %5.2f cusr %5.2f csys = %5.2f CPU)',
+ $usr, $sys, $cusr, $csys,
+ $usr + $sys + $cusr + $csys);
+ }
+
+ return "@time_report";
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness.pm
new file mode 100755
index 0000000000..4fbb045d11
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness.pm
@@ -0,0 +1,1072 @@
+package TAP::Harness;
+
+use strict;
+use warnings;
+use Carp;
+
+use File::Spec;
+use File::Path;
+use IO::Handle;
+
+use base 'TAP::Base';
+
+=head1 NAME
+
+TAP::Harness - Run test scripts with statistics
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+$ENV{HARNESS_ACTIVE} = 1;
+$ENV{HARNESS_VERSION} = $VERSION;
+
+END {
+
+ # For VMS.
+ delete $ENV{HARNESS_ACTIVE};
+ delete $ENV{HARNESS_VERSION};
+}
+
+=head1 DESCRIPTION
+
+This is a simple test harness which allows tests to be run and results
+automatically aggregated and output to STDOUT.
+
+=head1 SYNOPSIS
+
+ use TAP::Harness;
+ my $harness = TAP::Harness->new( \%args );
+ $harness->runtests(@tests);
+
+=cut
+
+my %VALIDATION_FOR;
+my @FORMATTER_ARGS;
+
+sub _error {
+ my $self = shift;
+ return $self->{error} unless @_;
+ $self->{error} = shift;
+}
+
+BEGIN {
+
+ @FORMATTER_ARGS = qw(
+ directives verbosity timer failures comments errors stdout color
+ show_count normalize
+ );
+
+ %VALIDATION_FOR = (
+ lib => sub {
+ my ( $self, $libs ) = @_;
+ $libs = [$libs] unless 'ARRAY' eq ref $libs;
+
+ return [ map {"-I$_"} @$libs ];
+ },
+ switches => sub { shift; shift },
+ exec => sub { shift; shift },
+ merge => sub { shift; shift },
+ aggregator_class => sub { shift; shift },
+ formatter_class => sub { shift; shift },
+ multiplexer_class => sub { shift; shift },
+ parser_class => sub { shift; shift },
+ scheduler_class => sub { shift; shift },
+ formatter => sub { shift; shift },
+ jobs => sub { shift; shift },
+ test_args => sub { shift; shift },
+ ignore_exit => sub { shift; shift },
+ rules => sub { shift; shift },
+ rulesfile => sub { shift; shift },
+ sources => sub { shift; shift },
+ version => sub { shift; shift },
+ trap => sub { shift; shift },
+ );
+
+ for my $method ( sort keys %VALIDATION_FOR ) {
+ no strict 'refs';
+ if ( $method eq 'lib' || $method eq 'switches' ) {
+ *{$method} = sub {
+ my $self = shift;
+ unless (@_) {
+ $self->{$method} ||= [];
+ return wantarray
+ ? @{ $self->{$method} }
+ : $self->{$method};
+ }
+ $self->_croak("Too many arguments to method '$method'")
+ if @_ > 1;
+ my $args = shift;
+ $args = [$args] unless ref $args;
+ $self->{$method} = $args;
+ return $self;
+ };
+ }
+ else {
+ *{$method} = sub {
+ my $self = shift;
+ return $self->{$method} unless @_;
+ $self->{$method} = shift;
+ };
+ }
+ }
+
+ for my $method (@FORMATTER_ARGS) {
+ no strict 'refs';
+ *{$method} = sub {
+ my $self = shift;
+ return $self->formatter->$method(@_);
+ };
+ }
+}
+
+##############################################################################
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my %args = (
+ verbosity => 1,
+ lib => [ 'lib', 'blib/lib', 'blib/arch' ],
+ )
+ my $harness = TAP::Harness->new( \%args );
+
+The constructor returns a new C<TAP::Harness> object. It accepts an
+optional hashref whose allowed keys are:
+
+=over 4
+
+=item * C<verbosity>
+
+Set the verbosity level:
+
+ 1 verbose Print individual test results to STDOUT.
+ 0 normal
+ -1 quiet Suppress some test output (mostly failures
+ while tests are running).
+ -2 really quiet Suppress everything but the tests summary.
+ -3 silent Suppress everything.
+
+=item * C<timer>
+
+Append run time for each test to output. Uses L<Time::HiRes> if
+available.
+
+=item * C<failures>
+
+Show test failures (this is a no-op if C<verbose> is selected).
+
+=item * C<comments>
+
+Show test comments (this is a no-op if C<verbose> is selected).
+
+=item * C<show_count>
+
+Update the running test count during testing.
+
+=item * C<normalize>
+
+Set to a true value to normalize the TAP that is emitted in verbose modes.
+
+=item * C<lib>
+
+Accepts a scalar value or array ref of scalar values indicating which
+paths to allowed libraries should be included if Perl tests are
+executed. Naturally, this only makes sense in the context of tests
+written in Perl.
+
+=item * C<switches>
+
+Accepts a scalar value or array ref of scalar values indicating which
+switches should be included if Perl tests are executed. Naturally, this
+only makes sense in the context of tests written in Perl.
+
+=item * C<test_args>
+
+A reference to an C<@INC> style array of arguments to be passed to each
+test program.
+
+ test_args => ['foo', 'bar'],
+
+if you want to pass different arguments to each test then you should
+pass a hash of arrays, keyed by the alias for each test:
+
+ test_args => {
+ my_test => ['foo', 'bar'],
+ other_test => ['baz'],
+ }
+
+=item * C<color>
+
+Attempt to produce color output.
+
+=item * C<exec>
+
+Typically, Perl tests are run through this. However, anything which
+spits out TAP is fine. You can use this argument to specify the name of
+the program (and optional switches) to run your tests with:
+
+ exec => ['/usr/bin/ruby', '-w']
+
+You can also pass a subroutine reference in order to determine and
+return the proper program to run based on a given test script. The
+subroutine reference should expect the TAP::Harness object itself as the
+first argument, and the file name as the second argument. It should
+return an array reference containing the command to be run and including
+the test file name. It can also simply return C<undef>, in which case
+TAP::Harness will fall back on executing the test script in Perl:
+
+ exec => sub {
+ my ( $harness, $test_file ) = @_;
+
+ # Let Perl tests run.
+ return undef if $test_file =~ /[.]t$/;
+ return [ qw( /usr/bin/ruby -w ), $test_file ]
+ if $test_file =~ /[.]rb$/;
+ }
+
+If the subroutine returns a scalar with a newline or a filehandle, it
+will be interpreted as raw TAP or as a TAP stream, respectively.
+
+=item * C<merge>
+
+If C<merge> is true the harness will create parsers that merge STDOUT
+and STDERR together for any processes they start.
+
+=item * C<sources>
+
+I<NEW to 3.18>.
+
+If set, C<sources> must be a hashref containing the names of the
+L<TAP::Parser::SourceHandler>s to load and/or configure. The values are a
+hash of configuration that will be accessible to the source handlers via
+L<TAP::Parser::Source/config_for>.
+
+For example:
+
+ sources => {
+ Perl => { exec => '/path/to/custom/perl' },
+ File => { extensions => [ '.tap', '.txt' ] },
+ MyCustom => { some => 'config' },
+ }
+
+The C<sources> parameter affects how C<source>, C<tap> and C<exec> parameters
+are handled.
+
+For more details, see the C<sources> parameter in L<TAP::Parser/new>,
+L<TAP::Parser::Source>, and L<TAP::Parser::IteratorFactory>.
+
+=item * C<aggregator_class>
+
+The name of the class to use to aggregate test results. The default is
+L<TAP::Parser::Aggregator>.
+
+=item * C<version>
+
+I<NEW to 3.22>.
+
+Assume this TAP version for L<TAP::Parser> instead of default TAP
+version 12.
+
+=item * C<formatter_class>
+
+The name of the class to use to format output. The default is
+L<TAP::Formatter::Console>, or L<TAP::Formatter::File> if the output
+isn't a TTY.
+
+=item * C<multiplexer_class>
+
+The name of the class to use to multiplex tests during parallel testing.
+The default is L<TAP::Parser::Multiplexer>.
+
+=item * C<parser_class>
+
+The name of the class to use to parse TAP. The default is
+L<TAP::Parser>.
+
+=item * C<scheduler_class>
+
+The name of the class to use to schedule test execution. The default is
+L<TAP::Parser::Scheduler>.
+
+=item * C<formatter>
+
+If set C<formatter> must be an object that is capable of formatting the
+TAP output. See L<TAP::Formatter::Console> for an example.
+
+=item * C<errors>
+
+If parse errors are found in the TAP output, a note of this will be
+made in the summary report. To see all of the parse errors, set this
+argument to true:
+
+ errors => 1
+
+=item * C<directives>
+
+If set to a true value, only test results with directives will be
+displayed. This overrides other settings such as C<verbose> or
+C<failures>.
+
+=item * C<ignore_exit>
+
+If set to a true value instruct C<TAP::Parser> to ignore exit and wait
+status from test scripts.
+
+=item * C<jobs>
+
+The maximum number of parallel tests to run at any time. Which tests
+can be run in parallel is controlled by C<rules>. The default is to
+run only one test at a time.
+
+=item * C<rules>
+
+A reference to a hash of rules that control which tests may be executed in
+parallel. If no rules are declared and L<CPAN::Meta::YAML> is available,
+C<TAP::Harness> attempts to load rules from a YAML file specified by the
+C<rulesfile> parameter. If no rules file exists, the default is for all
+tests to be eligible to be run in parallel.
+
+Here some simple examples. For the full details of the data structure
+and the related glob-style pattern matching, see
+L<TAP::Parser::Scheduler/"Rules data structure">.
+
+ # Run all tests in sequence, except those starting with "p"
+ $harness->rules({
+ par => 't/p*.t'
+ });
+
+ # Equivalent YAML file
+ ---
+ par: t/p*.t
+
+ # Run all tests in parallel, except those starting with "p"
+ $harness->rules({
+ seq => [
+ { seq => 't/p*.t' },
+ { par => '**' },
+ ],
+ });
+
+ # Equivalent YAML file
+ ---
+ seq:
+ - seq: t/p*.t
+ - par: **
+
+ # Run some startup tests in sequence, then some parallel tests than some
+ # teardown tests in sequence.
+ $harness->rules({
+ seq => [
+ { seq => 't/startup/*.t' },
+ { par => ['t/a/*.t','t/b/*.t','t/c/*.t'], }
+ { seq => 't/shutdown/*.t' },
+ ],
+
+ });
+
+ # Equivalent YAML file
+ ---
+ seq:
+ - seq: t/startup/*.t
+ - par:
+ - t/a/*.t
+ - t/b/*.t
+ - t/c/*.t
+ - seq: t/shutdown/*.t
+
+This is an experimental feature and the interface may change.
+
+=item * C<rulesfiles>
+
+This specifies where to find a YAML file of test scheduling rules. If not
+provided, it looks for a default file to use. It first checks for a file given
+in the C<HARNESS_RULESFILE> environment variable, then it checks for
+F<testrules.yml> and then F<t/testrules.yml>.
+
+=item * C<stdout>
+
+A filehandle for catching standard output.
+
+=item * C<trap>
+
+Attempt to print summary information if run is interrupted by
+SIGINT (Ctrl-C).
+
+=back
+
+Any keys for which the value is C<undef> will be ignored.
+
+=cut
+
+# new supplied by TAP::Base
+
+{
+ my @legal_callback = qw(
+ parser_args
+ made_parser
+ before_runtests
+ after_runtests
+ after_test
+ );
+
+ my %default_class = (
+ aggregator_class => 'TAP::Parser::Aggregator',
+ formatter_class => 'TAP::Formatter::Console',
+ multiplexer_class => 'TAP::Parser::Multiplexer',
+ parser_class => 'TAP::Parser',
+ scheduler_class => 'TAP::Parser::Scheduler',
+ );
+
+ sub _initialize {
+ my ( $self, $arg_for ) = @_;
+ $arg_for ||= {};
+
+ $self->SUPER::_initialize( $arg_for, \@legal_callback );
+ my %arg_for = %$arg_for; # force a shallow copy
+
+ for my $name ( sort keys %VALIDATION_FOR ) {
+ my $property = delete $arg_for{$name};
+ if ( defined $property ) {
+ my $validate = $VALIDATION_FOR{$name};
+
+ my $value = $self->$validate($property);
+ if ( $self->_error ) {
+ $self->_croak;
+ }
+ $self->$name($value);
+ }
+ }
+
+ $self->jobs(1) unless defined $self->jobs;
+
+ if ( ! defined $self->rules ) {
+ $self->_maybe_load_rulesfile;
+ }
+
+ local $default_class{formatter_class} = 'TAP::Formatter::File'
+ unless -t ( $arg_for{stdout} || \*STDOUT ) && !$ENV{HARNESS_NOTTY};
+
+ while ( my ( $attr, $class ) = each %default_class ) {
+ $self->$attr( $self->$attr() || $class );
+ }
+
+ unless ( $self->formatter ) {
+
+ # This is a little bodge to preserve legacy behaviour. It's
+ # pretty horrible that we know which args are destined for
+ # the formatter.
+ my %formatter_args = ( jobs => $self->jobs );
+ for my $name (@FORMATTER_ARGS) {
+ if ( defined( my $property = delete $arg_for{$name} ) ) {
+ $formatter_args{$name} = $property;
+ }
+ }
+
+ $self->formatter(
+ $self->_construct( $self->formatter_class, \%formatter_args )
+ );
+ }
+
+ if ( my @props = sort keys %arg_for ) {
+ $self->_croak("Unknown arguments to TAP::Harness::new (@props)");
+ }
+
+ return $self;
+ }
+
+ sub _maybe_load_rulesfile {
+ my ($self) = @_;
+
+ my ($rulesfile) = defined $self->rulesfile ? $self->rulesfile :
+ defined($ENV{HARNESS_RULESFILE}) ? $ENV{HARNESS_RULESFILE} :
+ grep { -r } qw(./testrules.yml t/testrules.yml);
+
+ if ( defined $rulesfile && -r $rulesfile ) {
+ if ( ! eval { require CPAN::Meta::YAML; 1} ) {
+ warn "CPAN::Meta::YAML required to process $rulesfile" ;
+ return;
+ }
+ my $layer = $] lt "5.008" ? "" : ":encoding(UTF-8)";
+ open my $fh, "<$layer", $rulesfile
+ or die "Couldn't open $rulesfile: $!";
+ my $yaml_text = do { local $/; <$fh> };
+ my $yaml = CPAN::Meta::YAML->read_string($yaml_text)
+ or die CPAN::Meta::YAML->errstr;
+ $self->rules( $yaml->[0] );
+ }
+ return;
+ }
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<runtests>
+
+ $harness->runtests(@tests);
+
+Accepts an array of C<@tests> to be run. This should generally be the
+names of test files, but this is not required. Each element in C<@tests>
+will be passed to C<TAP::Parser::new()> as a C<source>. See
+L<TAP::Parser> for more information.
+
+It is possible to provide aliases that will be displayed in place of the
+test name by supplying the test as a reference to an array containing
+C<< [ $test, $alias ] >>:
+
+ $harness->runtests( [ 't/foo.t', 'Foo Once' ],
+ [ 't/foo.t', 'Foo Twice' ] );
+
+Normally it is an error to attempt to run the same test twice. Aliases
+allow you to overcome this limitation by giving each run of the test a
+unique name.
+
+Tests will be run in the order found.
+
+If the environment variable C<PERL_TEST_HARNESS_DUMP_TAP> is defined it
+should name a directory into which a copy of the raw TAP for each test
+will be written. TAP is written to files named for each test.
+Subdirectories will be created as needed.
+
+Returns a L<TAP::Parser::Aggregator> containing the test results.
+
+=cut
+
+sub runtests {
+ my ( $self, @tests ) = @_;
+
+ my $aggregate = $self->_construct( $self->aggregator_class );
+
+ $self->_make_callback( 'before_runtests', $aggregate );
+ $aggregate->start;
+ my $finish = sub {
+ my $interrupted = shift;
+ $aggregate->stop;
+ $self->summary( $aggregate, $interrupted );
+ $self->_make_callback( 'after_runtests', $aggregate );
+ };
+ my $run = sub {
+ my $bailout;
+ eval { $self->aggregate_tests( $aggregate, @tests ); 1 }
+ or do { $bailout = $@ || 'unknown_error' };
+ $finish->();
+ die $bailout if defined $bailout;
+ };
+ $self->{bail_summary} = sub{
+ print "\n";
+ $finish->(1);
+ };
+
+ if ( $self->trap ) {
+ local $SIG{INT} = sub {
+ print "\n";
+ $finish->(1);
+ exit;
+ };
+ $run->();
+ }
+ else {
+ $run->();
+ }
+
+ return $aggregate;
+}
+
+=head3 C<summary>
+
+ $harness->summary( $aggregator );
+
+Output the summary for a L<TAP::Parser::Aggregator>.
+
+=cut
+
+sub summary {
+ my ( $self, @args ) = @_;
+ $self->formatter->summary(@args);
+}
+
+sub _after_test {
+ my ( $self, $aggregate, $job, $parser ) = @_;
+
+ $self->_make_callback( 'after_test', $job->as_array_ref, $parser );
+ $aggregate->add( $job->description, $parser );
+}
+
+sub _bailout {
+ my ( $self, $result, $parser, $session, $aggregate, $job ) = @_;
+
+ $self->finish_parser( $parser, $session );
+ $self->_after_test( $aggregate, $job, $parser );
+ $job->finish;
+
+ my $explanation = $result->explanation;
+ $self->{bail_summary}();
+ die "FAILED--Further testing stopped"
+ . ( $explanation ? ": $explanation\n" : ".\n" );
+}
+
+sub _aggregate_parallel {
+ my ( $self, $aggregate, $scheduler ) = @_;
+
+ my $jobs = $self->jobs;
+ my $mux = $self->_construct( $self->multiplexer_class );
+
+ RESULT: {
+
+ # Keep multiplexer topped up
+ FILL:
+ while ( $mux->parsers < $jobs ) {
+ my $job = $scheduler->get_job;
+
+ # If we hit a spinner stop filling and start running.
+ last FILL if !defined $job || $job->is_spinner;
+
+ my ( $parser, $session ) = $self->make_parser($job);
+ $mux->add( $parser, [ $session, $job ] );
+
+ # The job has started: begin the timers
+ $parser->start_time( $parser->get_time );
+ $parser->start_times( $parser->get_times );
+ }
+
+ if ( my ( $parser, $stash, $result ) = $mux->next ) {
+ my ( $session, $job ) = @$stash;
+ if ( defined $result ) {
+ $session->result($result);
+ $self->_bailout($result, $parser, $session, $aggregate, $job )
+ if $result->is_bailout;
+ }
+ else {
+
+ # End of parser. Automatically removed from the mux.
+ $self->finish_parser( $parser, $session );
+ $self->_after_test( $aggregate, $job, $parser );
+ $job->finish;
+ }
+ redo RESULT;
+ }
+ }
+
+ return;
+}
+
+sub _aggregate_single {
+ my ( $self, $aggregate, $scheduler ) = @_;
+
+ JOB:
+ while ( my $job = $scheduler->get_job ) {
+ next JOB if $job->is_spinner;
+
+ my ( $parser, $session ) = $self->make_parser($job);
+
+ while ( defined( my $result = $parser->next ) ) {
+ $session->result($result);
+ if ( $result->is_bailout ) {
+
+ # Keep reading until input is exhausted in the hope
+ # of allowing any pending diagnostics to show up.
+ 1 while $parser->next;
+ $self->_bailout($result, $parser, $session, $aggregate, $job );
+ }
+ }
+
+ $self->finish_parser( $parser, $session );
+ $self->_after_test( $aggregate, $job, $parser );
+ $job->finish;
+ }
+
+ return;
+}
+
+=head3 C<aggregate_tests>
+
+ $harness->aggregate_tests( $aggregate, @tests );
+
+Run the named tests and display a summary of result. Tests will be run
+in the order found.
+
+Test results will be added to the supplied L<TAP::Parser::Aggregator>.
+C<aggregate_tests> may be called multiple times to run several sets of
+tests. Multiple C<Test::Harness> instances may be used to pass results
+to a single aggregator so that different parts of a complex test suite
+may be run using different C<TAP::Harness> settings. This is useful, for
+example, in the case where some tests should run in parallel but others
+are unsuitable for parallel execution.
+
+ my $formatter = TAP::Formatter::Console->new;
+ my $ser_harness = TAP::Harness->new( { formatter => $formatter } );
+ my $par_harness = TAP::Harness->new(
+ { formatter => $formatter,
+ jobs => 9
+ }
+ );
+ my $aggregator = TAP::Parser::Aggregator->new;
+
+ $aggregator->start();
+ $ser_harness->aggregate_tests( $aggregator, @ser_tests );
+ $par_harness->aggregate_tests( $aggregator, @par_tests );
+ $aggregator->stop();
+ $formatter->summary($aggregator);
+
+Note that for simpler testing requirements it will often be possible to
+replace the above code with a single call to C<runtests>.
+
+Each element of the C<@tests> array is either:
+
+=over
+
+=item * the source name of a test to run
+
+=item * a reference to a [ source name, display name ] array
+
+=back
+
+In the case of a perl test suite, typically I<source names> are simply the file
+names of the test scripts to run.
+
+When you supply a separate display name it becomes possible to run a
+test more than once; the display name is effectively the alias by which
+the test is known inside the harness. The harness doesn't care if it
+runs the same test more than once when each invocation uses a
+different name.
+
+=cut
+
+sub aggregate_tests {
+ my ( $self, $aggregate, @tests ) = @_;
+
+ my $jobs = $self->jobs;
+ my $scheduler = $self->make_scheduler(@tests);
+
+ # #12458
+ local $ENV{HARNESS_IS_VERBOSE} = 1
+ if $self->formatter->verbosity > 0;
+
+ # Formatter gets only names.
+ $self->formatter->prepare( map { $_->description } $scheduler->get_all );
+
+ if ( $self->jobs > 1 ) {
+ $self->_aggregate_parallel( $aggregate, $scheduler );
+ }
+ else {
+ $self->_aggregate_single( $aggregate, $scheduler );
+ }
+
+ return;
+}
+
+sub _add_descriptions {
+ my $self = shift;
+
+ # Turn unwrapped scalars into anonymous arrays and copy the name as
+ # the description for tests that have only a name.
+ return map { @$_ == 1 ? [ $_->[0], $_->[0] ] : $_ }
+ map { 'ARRAY' eq ref $_ ? $_ : [$_] } @_;
+}
+
+=head3 C<make_scheduler>
+
+Called by the harness when it needs to create a
+L<TAP::Parser::Scheduler>. Override in a subclass to provide an
+alternative scheduler. C<make_scheduler> is passed the list of tests
+that was passed to C<aggregate_tests>.
+
+=cut
+
+sub make_scheduler {
+ my ( $self, @tests ) = @_;
+ return $self->_construct(
+ $self->scheduler_class,
+ tests => [ $self->_add_descriptions(@tests) ],
+ rules => $self->rules
+ );
+}
+
+=head3 C<jobs>
+
+Gets or sets the number of concurrent test runs the harness is
+handling. By default, this value is 1 -- for parallel testing, this
+should be set higher.
+
+=cut
+
+##############################################################################
+
+sub _get_parser_args {
+ my ( $self, $job ) = @_;
+ my $test_prog = $job->filename;
+ my %args = ();
+
+ $args{sources} = $self->sources if $self->sources;
+
+ my @switches;
+ @switches = $self->lib if $self->lib;
+ push @switches => $self->switches if $self->switches;
+ $args{switches} = \@switches;
+ $args{spool} = $self->_open_spool($test_prog);
+ $args{merge} = $self->merge;
+ $args{ignore_exit} = $self->ignore_exit;
+ $args{version} = $self->version if $self->version;
+
+ if ( my $exec = $self->exec ) {
+ $args{exec}
+ = ref $exec eq 'CODE'
+ ? $exec->( $self, $test_prog )
+ : [ @$exec, $test_prog ];
+ if ( not defined $args{exec} ) {
+ $args{source} = $test_prog;
+ }
+ elsif ( ( ref( $args{exec} ) || "" ) ne "ARRAY" ) {
+ $args{source} = delete $args{exec};
+ }
+ }
+ else {
+ $args{source} = $test_prog;
+ }
+
+ if ( defined( my $test_args = $self->test_args ) ) {
+
+ if ( ref($test_args) eq 'HASH' ) {
+
+ # different args for each test
+ if ( exists( $test_args->{ $job->description } ) ) {
+ $test_args = $test_args->{ $job->description };
+ }
+ else {
+ $self->_croak( "TAP::Harness Can't find test_args for "
+ . $job->description );
+ }
+ }
+
+ $args{test_args} = $test_args;
+ }
+
+ return \%args;
+}
+
+=head3 C<make_parser>
+
+Make a new parser and display formatter session. Typically used and/or
+overridden in subclasses.
+
+ my ( $parser, $session ) = $harness->make_parser;
+
+=cut
+
+sub make_parser {
+ my ( $self, $job ) = @_;
+
+ my $args = $self->_get_parser_args($job);
+ $self->_make_callback( 'parser_args', $args, $job->as_array_ref );
+ my $parser = $self->_construct( $self->parser_class, $args );
+
+ $self->_make_callback( 'made_parser', $parser, $job->as_array_ref );
+ my $session = $self->formatter->open_test( $job->description, $parser );
+
+ return ( $parser, $session );
+}
+
+=head3 C<finish_parser>
+
+Terminate use of a parser. Typically used and/or overridden in
+subclasses. The parser isn't destroyed as a result of this.
+
+=cut
+
+sub finish_parser {
+ my ( $self, $parser, $session ) = @_;
+
+ $session->close_test;
+ $self->_close_spool($parser);
+
+ return $parser;
+}
+
+sub _open_spool {
+ my $self = shift;
+ my $test = shift;
+
+ if ( my $spool_dir = $ENV{PERL_TEST_HARNESS_DUMP_TAP} ) {
+
+ my $spool = File::Spec->catfile( $spool_dir, $test );
+
+ # Make the directory
+ my ( $vol, $dir, undef ) = File::Spec->splitpath($spool);
+ my $path = File::Spec->catpath( $vol, $dir, '' );
+ eval { mkpath($path) };
+ $self->_croak($@) if $@;
+
+ my $spool_handle = IO::Handle->new;
+ open( $spool_handle, ">$spool" )
+ or $self->_croak(" Can't write $spool ( $! ) ");
+
+ return $spool_handle;
+ }
+
+ return;
+}
+
+sub _close_spool {
+ my $self = shift;
+ my ($parser) = @_;
+
+ if ( my $spool_handle = $parser->delete_spool ) {
+ close($spool_handle)
+ or $self->_croak(" Error closing TAP spool file( $! ) \n ");
+ }
+
+ return;
+}
+
+sub _croak {
+ my ( $self, $message ) = @_;
+ unless ($message) {
+ $message = $self->_error;
+ }
+ $self->SUPER::_croak($message);
+
+ return;
+}
+
+1;
+
+__END__
+
+##############################################################################
+
+=head1 CONFIGURING
+
+C<TAP::Harness> is designed to be easy to configure.
+
+=head2 Plugins
+
+C<TAP::Parser> plugins let you change the way TAP is I<input> to and I<output>
+from the parser.
+
+L<TAP::Parser::SourceHandler>s handle TAP I<input>. You can configure them
+and load custom handlers using the C<sources> parameter to L</new>.
+
+L<TAP::Formatter>s handle TAP I<output>. You can load custom formatters by
+using the C<formatter_class> parameter to L</new>. To configure a formatter,
+you currently need to instantiate it outside of L<TAP::Harness> and pass it in
+with the C<formatter> parameter to L</new>. This I<may> be addressed by adding
+a I<formatters> parameter to L</new> in the future.
+
+=head2 C<Module::Build>
+
+L<Module::Build> version C<0.30> supports C<TAP::Harness>.
+
+To load C<TAP::Harness> plugins, you'll need to use the C<tap_harness_args>
+parameter to C<new>, typically from your C<Build.PL>. For example:
+
+ Module::Build->new(
+ module_name => 'MyApp',
+ test_file_exts => [qw(.t .tap .txt)],
+ use_tap_harness => 1,
+ tap_harness_args => {
+ sources => {
+ MyCustom => {},
+ File => {
+ extensions => ['.tap', '.txt'],
+ },
+ },
+ formatter_class => 'TAP::Formatter::HTML',
+ },
+ build_requires => {
+ 'Module::Build' => '0.30',
+ 'TAP::Harness' => '3.18',
+ },
+ )->create_build_script;
+
+See L</new>
+
+=head2 C<ExtUtils::MakeMaker>
+
+L<ExtUtils::MakeMaker> does not support L<TAP::Harness> out-of-the-box.
+
+=head2 C<prove>
+
+L<prove> supports C<TAP::Harness> plugins, and has a plugin system of its
+own. See L<prove/FORMATTERS>, L<prove/SOURCE HANDLERS> and L<App::Prove>
+for more details.
+
+=head1 WRITING PLUGINS
+
+If you can't configure C<TAP::Harness> to do what you want, and you can't find
+an existing plugin, consider writing one.
+
+The two primary use cases supported by L<TAP::Harness> for plugins are I<input>
+and I<output>:
+
+=over 2
+
+=item Customize how TAP gets into the parser
+
+To do this, you can either extend an existing L<TAP::Parser::SourceHandler>,
+or write your own. It's a pretty simple API, and they can be loaded and
+configured using the C<sources> parameter to L</new>.
+
+=item Customize how TAP results are output from the parser
+
+To do this, you can either extend an existing L<TAP::Formatter>, or write your
+own. Writing formatters are a bit more involved than writing a
+I<SourceHandler>, as you'll need to understand the L<TAP::Parser> API. A
+good place to start is by understanding how L</aggregate_tests> works.
+
+Custom formatters can be loaded configured using the C<formatter_class>
+parameter to L</new>.
+
+=back
+
+=head1 SUBCLASSING
+
+If you can't configure C<TAP::Harness> to do exactly what you want, and writing
+a plugin isn't an option, consider extending it. It is designed to be (mostly)
+easy to subclass, though the cases when sub-classing is necessary should be few
+and far between.
+
+=head2 Methods
+
+The following methods are ones you may wish to override if you want to
+subclass C<TAP::Harness>.
+
+=over 4
+
+=item L</new>
+
+=item L</runtests>
+
+=item L</summary>
+
+=back
+
+=cut
+
+=head1 REPLACING
+
+If you like the C<prove> utility and L<TAP::Parser> but you want your
+own harness, all you need to do is write one and provide C<new> and
+C<runtests> methods. Then you can use the C<prove> utility like so:
+
+ prove --harness My::Test::Harness
+
+Note that while C<prove> accepts a list of tests (or things to be
+tested), C<new> has a fairly rich set of arguments. You'll probably want
+to read over this code carefully to see how all of them are being used.
+
+=head1 SEE ALSO
+
+L<Test::Harness>
+
+=cut
+
+# vim:ts=4:sw=4:et:sta
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Beyond.pod b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Beyond.pod
new file mode 100755
index 0000000000..989e2efc14
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Beyond.pod
@@ -0,0 +1,426 @@
+=head1 NAME
+
+Test::Harness::Beyond - Beyond make test
+
+=head1 Beyond make test
+
+Test::Harness is responsible for running test scripts, analysing
+their output and reporting success or failure. When I type
+F<make test> (or F<./Build test>) for a module, Test::Harness is usually
+used to run the tests (not all modules use Test::Harness but the
+majority do).
+
+To start exploring some of the features of Test::Harness I need to
+switch from F<make test> to the F<prove> command (which ships with
+Test::Harness). For the following examples I'll also need a recent
+version of Test::Harness installed; 3.14 is current as I write.
+
+For the examples I'm going to assume that we're working with a
+'normal' Perl module distribution. Specifically I'll assume that
+typing F<make> or F<./Build> causes the built, ready-to-install module
+code to be available below ./blib/lib and ./blib/arch and that
+there's a directory called 't' that contains our tests. Test::Harness
+isn't hardwired to that configuration but it saves me from explaining
+which files live where for each example.
+
+Back to F<prove>; like F<make test> it runs a test suite - but it
+provides far more control over which tests are executed, in what
+order and how their results are reported. Typically F<make test>
+runs all the test scripts below the 't' directory. To do the same
+thing with prove I type:
+
+ prove -rb t
+
+The switches here are -r to recurse into any directories below 't'
+and -b which adds ./blib/lib and ./blib/arch to Perl's include path
+so that the tests can find the code they will be testing. If I'm
+testing a module of which an earlier version is already installed
+I need to be careful about the include path to make sure I'm not
+running my tests against the installed version rather than the new
+one that I'm working on.
+
+Unlike F<make test>, typing F<prove> doesn't automatically rebuild
+my module. If I forget to make before prove I will be testing against
+older versions of those files - which inevitably leads to confusion.
+I either get into the habit of typing
+
+ make && prove -rb t
+
+or - if I have no XS code that needs to be built I use the modules
+below F<lib> instead
+
+ prove -Ilib -r t
+
+So far I've shown you nothing that F<make test> doesn't do. Let's
+fix that.
+
+=head2 Saved State
+
+If I have failing tests in a test suite that consists of more than
+a handful of scripts and takes more than a few seconds to run it
+rapidly becomes tedious to run the whole test suite repeatedly as
+I track down the problems.
+
+I can tell prove just to run the tests that are failing like this:
+
+ prove -b t/this_fails.t t/so_does_this.t
+
+That speeds things up but I have to make a note of which tests are
+failing and make sure that I run those tests. Instead I can use
+prove's --state switch and have it keep track of failing tests for
+me. First I do a complete run of the test suite and tell prove to
+save the results:
+
+ prove -rb --state=save t
+
+That stores a machine readable summary of the test run in a file
+called '.prove' in the current directory. If I have failures I can
+then run just the failing scripts like this:
+
+ prove -b --state=failed
+
+I can also tell prove to save the results again so that it updates
+its idea of which tests failed:
+
+ prove -b --state=failed,save
+
+As soon as one of my failing tests passes it will be removed from
+the list of failed tests. Eventually I fix them all and prove can
+find no failing tests to run:
+
+ Files=0, Tests=0, 0 wallclock secs ( 0.00 usr + 0.00 sys = 0.00 CPU)
+ Result: NOTESTS
+
+As I work on a particular part of my module it's most likely that
+the tests that cover that code will fail. I'd like to run the whole
+test suite but have it prioritize these 'hot' tests. I can tell
+prove to do this:
+
+ prove -rb --state=hot,save t
+
+All the tests will run but those that failed most recently will be
+run first. If no tests have failed since I started saving state all
+tests will run in their normal order. This combines full test
+coverage with early notification of failures.
+
+The --state switch supports a number of options; for example to run
+failed tests first followed by all remaining tests ordered by the
+timestamps of the test scripts - and save the results - I can use
+
+ prove -rb --state=failed,new,save t
+
+See the prove documentation (type prove --man) for the full list
+of state options.
+
+When I tell prove to save state it writes a file called '.prove'
+('_prove' on Windows) in the current directory. It's a YAML document
+so it's quite easy to write tools of your own that work on the saved
+test state - but the format isn't officially documented so it might
+change without (much) warning in the future.
+
+=head2 Parallel Testing
+
+If my tests take too long to run I may be able to speed them up by
+running multiple test scripts in parallel. This is particularly
+effective if the tests are I/O bound or if I have multiple CPU
+cores. I tell prove to run my tests in parallel like this:
+
+ prove -rb -j 9 t
+
+The -j switch enables parallel testing; the number that follows it
+is the maximum number of tests to run in parallel. Sometimes tests
+that pass when run sequentially will fail when run in parallel. For
+example if two different test scripts use the same temporary file
+or attempt to listen on the same socket I'll have problems running
+them in parallel. If I see unexpected failures I need to check my
+tests to work out which of them are trampling on the same resource
+and rename temporary files or add locks as appropriate.
+
+To get the most performance benefit I want to have the test scripts
+that take the longest to run start first - otherwise I'll be waiting
+for the one test that takes nearly a minute to complete after all
+the others are done. I can use the --state switch to run the tests
+in slowest to fastest order:
+
+ prove -rb -j 9 --state=slow,save t
+
+=head2 Non-Perl Tests
+
+The Test Anything Protocol (http://testanything.org/) isn't just
+for Perl. Just about any language can be used to write tests that
+output TAP. There are TAP based testing libraries for C, C++, PHP,
+Python and many others. If I can't find a TAP library for my language
+of choice it's easy to generate valid TAP. It looks like this:
+
+ 1..3
+ ok 1 - init OK
+ ok 2 - opened file
+ not ok 3 - appended to file
+
+The first line is the plan - it specifies the number of tests I'm
+going to run so that it's easy to check that the test script didn't
+exit before running all the expected tests. The following lines are
+the test results - 'ok' for pass, 'not ok' for fail. Each test has
+a number and, optionally, a description. And that's it. Any language
+that can produce output like that on STDOUT can be used to write
+tests.
+
+Recently I've been rekindling a two-decades-old interest in Forth.
+Evidently I have a masochistic streak that even Perl can't satisfy.
+I want to write tests in Forth and run them using prove (you can
+find my gforth TAP experiments at
+https://svn.hexten.net/andy/Forth/Testing/). I can use the --exec
+switch to tell prove to run the tests using gforth like this:
+
+ prove -r --exec gforth t
+
+Alternately, if the language used to write my tests allows a shebang
+line I can use that to specify the interpreter. Here's a test written
+in PHP:
+
+ #!/usr/bin/php
+ <?php
+ print "1..2\n";
+ print "ok 1\n";
+ print "not ok 2\n";
+ ?>
+
+If I save that as t/phptest.t the shebang line will ensure that it
+runs correctly along with all my other tests.
+
+=head2 Mixing it up
+
+Subtle interdependencies between test programs can mask problems -
+for example an earlier test may neglect to remove a temporary file
+that affects the behaviour of a later test. To find this kind of
+problem I use the --shuffle and --reverse options to run my tests
+in random or reversed order.
+
+=head2 Rolling My Own
+
+If I need a feature that prove doesn't provide I can easily write my own.
+
+Typically you'll want to change how TAP gets I<input> into and I<output>
+from the parser. L<App::Prove> supports arbitrary plugins, and L<TAP::Harness>
+supports custom I<formatters> and I<source handlers> that you can load using
+either L<prove> or L<Module::Build>; there are many examples to base mine on.
+For more details see L<App::Prove>, L<TAP::Parser::SourceHandler>, and
+L<TAP::Formatter::Base>.
+
+If writing a plugin is not enough, you can write your own test harness; one of
+the motives for the 3.00 rewrite of Test::Harness was to make it easier to
+subclass and extend.
+
+The Test::Harness module is a compatibility wrapper around TAP::Harness.
+For new applications I should use TAP::Harness directly. As we'll
+see, prove uses TAP::Harness.
+
+When I run prove it processes its arguments, figures out which test
+scripts to run and then passes control to TAP::Harness to run the
+tests, parse, analyse and present the results. By subclassing
+TAP::Harness I can customise many aspects of the test run.
+
+I want to log my test results in a database so I can track them
+over time. To do this I override the summary method in TAP::Harness.
+I start with a simple prototype that dumps the results as a YAML
+document:
+
+ package My::TAP::Harness;
+
+ use base 'TAP::Harness';
+ use YAML;
+
+ sub summary {
+ my ( $self, $aggregate ) = @_;
+ print Dump( $aggregate );
+ $self->SUPER::summary( $aggregate );
+ }
+
+ 1;
+
+I need to tell prove to use my My::TAP::Harness. If My::TAP::Harness
+is on Perl's @INC include path I can
+
+ prove --harness=My::TAP::Harness -rb t
+
+If I don't have My::TAP::Harness installed on @INC I need to provide
+the correct path to perl when I run prove:
+
+ perl -Ilib `which prove` --harness=My::TAP::Harness -rb t
+
+I can incorporate these options into my own version of prove. It's
+pretty simple. Most of the work of prove is handled by App::Prove.
+The important code in prove is just:
+
+ use App::Prove;
+
+ my $app = App::Prove->new;
+ $app->process_args(@ARGV);
+ exit( $app->run ? 0 : 1 );
+
+If I write a subclass of App::Prove I can customise any aspect of
+the test runner while inheriting all of prove's behaviour. Here's
+myprove:
+
+ #!/usr/bin/env perl use lib qw( lib ); # Add ./lib to @INC
+ use App::Prove;
+
+ my $app = App::Prove->new;
+
+ # Use custom TAP::Harness subclass
+ $app->harness( 'My::TAP::Harness' );
+
+ $app->process_args( @ARGV ); exit( $app->run ? 0 : 1 );
+
+Now I can run my tests like this
+
+ ./myprove -rb t
+
+=head2 Deeper Customisation
+
+Now that I know how to subclass and replace TAP::Harness I can
+replace any other part of the harness. To do that I need to know
+which classes are responsible for which functionality. Here's a
+brief guided tour; the default class for each component is shown
+in parentheses. Normally any replacements I write will be subclasses
+of these default classes.
+
+When I run my tests TAP::Harness creates a scheduler
+(TAP::Parser::Scheduler) to work out the running order for the
+tests, an aggregator (TAP::Parser::Aggregator) to collect and analyse
+the test results and a formatter (TAP::Formatter::Console) to display
+those results.
+
+If I'm running my tests in parallel there may also be a multiplexer
+(TAP::Parser::Multiplexer) - the component that allows multiple
+tests to run simultaneously.
+
+Once it has created those helpers TAP::Harness starts running the
+tests. For each test it creates a new parser (TAP::Parser) which
+is responsible for running the test script and parsing its output.
+
+To replace any of these components I call one of these harness
+methods with the name of the replacement class:
+
+ aggregator_class
+ formatter_class
+ multiplexer_class
+ parser_class
+ scheduler_class
+
+For example, to replace the aggregator I would
+
+ $harness->aggregator_class( 'My::Aggregator' );
+
+Alternately I can supply the names of my substitute classes to the
+TAP::Harness constructor:
+
+ my $harness = TAP::Harness->new(
+ { aggregator_class => 'My::Aggregator' }
+ );
+
+If I need to reach even deeper into the internals of the harness I
+can replace the classes that TAP::Parser uses to execute test scripts
+and tokenise their output. Before running a test script TAP::Parser
+creates a grammar (TAP::Parser::Grammar) to decode the raw TAP into
+tokens, a result factory (TAP::Parser::ResultFactory) to turn the
+decoded TAP results into objects and, depending on whether it's
+running a test script or reading TAP from a file, scalar or array
+a source or an iterator (TAP::Parser::IteratorFactory).
+
+Each of these objects may be replaced by calling one of these parser
+methods:
+
+ source_class
+ perl_source_class
+ grammar_class
+ iterator_factory_class
+ result_factory_class
+
+=head2 Callbacks
+
+As an alternative to subclassing the components I need to change I
+can attach callbacks to the default classes. TAP::Harness exposes
+these callbacks:
+
+ parser_args Tweak the parameters used to create the parser
+ made_parser Just made a new parser
+ before_runtests About to run tests
+ after_runtests Have run all tests
+ after_test Have run an individual test script
+
+TAP::Parser also supports callbacks; bailout, comment, plan, test,
+unknown, version and yaml are called for the corresponding TAP
+result types, ALL is called for all results, ELSE is called for all
+results for which a named callback is not installed and EOF is
+called once at the end of each TAP stream.
+
+To install a callback I pass the name of the callback and a subroutine
+reference to TAP::Harness or TAP::Parser's callback method:
+
+ $harness->callback( after_test => sub {
+ my ( $script, $desc, $parser ) = @_;
+ } );
+
+I can also pass callbacks to the constructor:
+
+ my $harness = TAP::Harness->new({
+ callbacks => {
+ after_test => sub {
+ my ( $script, $desc, $parser ) = @_;
+ # Do something interesting here
+ }
+ }
+ });
+
+When it comes to altering the behaviour of the test harness there's
+more than one way to do it. Which way is best depends on my
+requirements. In general if I only want to observe test execution
+without changing the harness' behaviour (for example to log test
+results to a database) I choose callbacks. If I want to make the
+harness behave differently subclassing gives me more control.
+
+=head2 Parsing TAP
+
+Perhaps I don't need a complete test harness. If I already have a
+TAP test log that I need to parse all I need is TAP::Parser and the
+various classes it depends upon. Here's the code I need to run a
+test and parse its TAP output
+
+ use TAP::Parser;
+
+ my $parser = TAP::Parser->new( { source => 't/simple.t' } );
+ while ( my $result = $parser->next ) {
+ print $result->as_string, "\n";
+ }
+
+Alternately I can pass an open filehandle as source and have the
+parser read from that rather than attempting to run a test script:
+
+ open my $tap, '<', 'tests.tap'
+ or die "Can't read TAP transcript ($!)\n";
+ my $parser = TAP::Parser->new( { source => $tap } );
+ while ( my $result = $parser->next ) {
+ print $result->as_string, "\n";
+ }
+
+This approach is useful if I need to convert my TAP based test
+results into some other representation. See TAP::Convert::TET
+(http://search.cpan.org/dist/TAP-Convert-TET/) for an example of
+this approach.
+
+=head2 Getting Support
+
+The Test::Harness developers hang out on the tapx-dev mailing
+list[1]. For discussion of general, language independent TAP issues
+there's the tap-l[2] list. Finally there's a wiki dedicated to the
+Test Anything Protocol[3]. Contributions to the wiki, patches and
+suggestions are all welcome.
+
+=for comment
+ The URLs in [1] and [2] point to 404 pages. What are currently the
+ correct URLs?
+
+[1] L<http://www.hexten.net/mailman/listinfo/tapx-dev>
+[2] L<http://testanything.org/mailman/listinfo/tap-l>
+[3] L<http://testanything.org/>
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Env.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Env.pm
new file mode 100755
index 0000000000..8d46d3856b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Harness/Env.pm
@@ -0,0 +1,215 @@
+package TAP::Harness::Env;
+
+use strict;
+use warnings;
+
+use constant IS_VMS => ( $^O eq 'VMS' );
+use TAP::Object;
+use Text::ParseWords qw/shellwords/;
+
+our $VERSION = '3.48';
+
+# Get the parts of @INC which are changed from the stock list AND
+# preserve reordering of stock directories.
+sub _filtered_inc_vms {
+ my @inc = grep { !ref } @INC; #28567
+
+ # VMS has a 255-byte limit on the length of %ENV entries, so
+ # toss the ones that involve perl_root, the install location
+ @inc = grep { !/perl_root/i } @inc;
+
+ my @default_inc = _default_inc();
+
+ my @new_inc;
+ my %seen;
+ for my $dir (@inc) {
+ next if $seen{$dir}++;
+
+ if ( $dir eq ( $default_inc[0] || '' ) ) {
+ shift @default_inc;
+ }
+ else {
+ push @new_inc, $dir;
+ }
+
+ shift @default_inc while @default_inc and $seen{ $default_inc[0] };
+ }
+ return @new_inc;
+}
+
+# Cache this to avoid repeatedly shelling out to Perl.
+my @inc;
+
+sub _default_inc {
+ return @inc if @inc;
+
+ local $ENV{PERL5LIB};
+ local $ENV{PERLLIB};
+
+ my $perl = $ENV{HARNESS_PERL} || $^X;
+
+ # Avoid using -l for the benefit of Perl 6
+ chomp( @inc = `"$perl" -e "print join qq[\\n], \@INC, q[]"` );
+ return @inc;
+}
+
+sub create {
+ my $package = shift;
+ my %input = %{ shift || {} };
+
+ my @libs = @{ delete $input{lib} || [] };
+ my @raw_switches = @{ delete $input{switches} || [] };
+ my @opt
+ = ( @raw_switches, shellwords( $ENV{HARNESS_PERL_SWITCHES} || '' ) );
+ my @switches;
+ while ( my $opt = shift @opt ) {
+ if ( $opt =~ /^ -I (.*) $ /x ) {
+ push @libs, length($1) ? $1 : shift @opt;
+ }
+ else {
+ push @switches, $opt;
+ }
+ }
+
+ # Do things the old way on VMS...
+ push @libs, _filtered_inc_vms() if IS_VMS;
+
+ # If $Verbose isn't numeric default to 1. This helps core.
+ my $verbose
+ = $ENV{HARNESS_VERBOSE}
+ ? $ENV{HARNESS_VERBOSE} !~ /\d/
+ ? 1
+ : $ENV{HARNESS_VERBOSE}
+ : 0;
+
+ my %args = (
+ lib => \@libs,
+ timer => $ENV{HARNESS_TIMER} || 0,
+ switches => \@switches,
+ color => $ENV{HARNESS_COLOR} || 0,
+ verbosity => $verbose,
+ ignore_exit => $ENV{HARNESS_IGNORE_EXIT} || 0,
+ );
+
+ my $class = delete $input{harness_class} || $ENV{HARNESS_SUBCLASS} || 'TAP::Harness';
+ if ( defined( my $env_opt = $ENV{HARNESS_OPTIONS} ) ) {
+ for my $opt ( split /:/, $env_opt ) {
+ if ( $opt =~ /^j(\d*)$/ ) {
+ $args{jobs} = $1 || 9;
+ }
+ elsif ( $opt eq 'c' ) {
+ $args{color} = 1;
+ }
+ elsif ( $opt =~ m/^f(.*)$/ ) {
+ my $fmt = $1;
+ $fmt =~ s/-/::/g;
+ $args{formatter_class} = $fmt;
+ }
+ elsif ( $opt =~ m/^a(.*)$/ ) {
+ my $archive = $1;
+ $class = 'TAP::Harness::Archive';
+ $args{archive} = $archive;
+ }
+ else {
+ die "Unknown HARNESS_OPTIONS item: $opt\n";
+ }
+ }
+ }
+ return TAP::Object->_construct($class, { %args, %input });
+}
+
+1;
+
+=head1 NAME
+
+TAP::Harness::Env - Parsing harness related environmental variables where appropriate
+
+=head1 VERSION
+
+Version 3.48
+
+=head1 SYNOPSIS
+
+ my $harness = TAP::Harness::Env->create(\%extra_args)
+
+=head1 DESCRIPTION
+
+This module implements the environmental variables that L<Test::Harness> uses with TAP::Harness, and instantiates the appropriate class with the appropriate arguments.
+
+=head1 METHODS
+
+=over 4
+
+=item * create( \%args )
+
+This function reads the environment and generates an appropriate argument hash from it. If given any arguments in C<%extra_args>, these will override the environmental defaults. In accepts C<harness_class> (which defaults to C<TAP::Harness>), and any argument the harness class accepts.
+
+=back
+
+=head1 ENVIRONMENTAL VARIABLES
+
+=over 4
+
+=item C<HARNESS_PERL_SWITCHES>
+
+Setting this adds perl command line switches to each test file run.
+
+For example, C<HARNESS_PERL_SWITCHES=-T> will turn on taint mode.
+C<HARNESS_PERL_SWITCHES=-MDevel::Cover> will run C<Devel::Cover> for
+each test.
+
+=item C<HARNESS_VERBOSE>
+
+If true, C<TAP::Harness> will output the verbose results of running
+its tests.
+
+=item C<HARNESS_SUBCLASS>
+
+Specifies a TAP::Harness subclass to be used in place of TAP::Harness.
+
+=item C<HARNESS_OPTIONS>
+
+Provide additional options to the harness. Currently supported options are:
+
+=over
+
+=item C<< j<n> >>
+
+Run <n> (default 9) parallel jobs.
+
+=item C<< c >>
+
+Try to color output. See L<TAP::Formatter::Base/"new">.
+
+=item C<< a<file.tgz> >>
+
+Will use L<TAP::Harness::Archive> as the harness class, and save the TAP to
+C<file.tgz>
+
+=item C<< fPackage-With-Dashes >>
+
+Set the formatter_class of the harness being run. Since the C<HARNESS_OPTIONS>
+is separated by C<:>, we use C<-> instead.
+
+=back
+
+Multiple options may be separated by colons:
+
+ HARNESS_OPTIONS=j9:c make test
+
+=item C<HARNESS_TIMER>
+
+Setting this to true will make the harness display the number of
+milliseconds each test took. You can also use F<prove>'s C<--timer>
+switch.
+
+=item C<HARNESS_COLOR>
+
+Attempt to produce color output.
+
+=item C<HARNESS_IGNORE_EXIT>
+
+If set to a true value instruct C<TAP::Parser> to ignore exit and wait
+status from test scripts.
+
+=back
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm
new file mode 100755
index 0000000000..a012b98a6c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Object.pm
@@ -0,0 +1,155 @@
+package TAP::Object;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+TAP::Object - Base class that provides common functionality to all C<TAP::*> modules
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ package TAP::Whatever;
+
+ use strict;
+
+ use base 'TAP::Object';
+
+ # new() implementation by TAP::Object
+ sub _initialize {
+ my ( $self, @args) = @_;
+ # initialize your object
+ return $self;
+ }
+
+ # ... later ...
+ my $obj = TAP::Whatever->new(@args);
+
+=head1 DESCRIPTION
+
+C<TAP::Object> provides a default constructor and exception model for all
+C<TAP::*> classes. Exceptions are raised using L<Carp>.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Create a new object. Any arguments passed to C<new> will be passed on to the
+L</_initialize> method. Returns a new object.
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = bless {}, $class;
+ return $self->_initialize(@_);
+}
+
+=head2 Instance Methods
+
+=head3 C<_initialize>
+
+Initializes a new object. This method is a stub by default, you should override
+it as appropriate.
+
+I<Note:> L</new> expects you to return C<$self> or raise an exception. See
+L</_croak>, and L<Carp>.
+
+=cut
+
+sub _initialize {
+ return $_[0];
+}
+
+=head3 C<_croak>
+
+Raise an exception using C<croak> from L<Carp>, eg:
+
+ $self->_croak( 'why me?', 'aaarrgh!' );
+
+May also be called as a I<class> method.
+
+ $class->_croak( 'this works too' );
+
+=cut
+
+sub _croak {
+ my $proto = shift;
+ require Carp;
+ Carp::croak(@_);
+ return;
+}
+
+=head3 C<_confess>
+
+Raise an exception using C<confess> from L<Carp>, eg:
+
+ $self->_confess( 'why me?', 'aaarrgh!' );
+
+May also be called as a I<class> method.
+
+ $class->_confess( 'this works too' );
+
+=cut
+
+sub _confess {
+ my $proto = shift;
+ require Carp;
+ Carp::confess(@_);
+ return;
+}
+
+=head3 C<_construct>
+
+Create a new instance of the specified class.
+
+=cut
+
+sub _construct {
+ my ( $self, $class, @args ) = @_;
+
+ $self->_croak("Bad module name $class")
+ unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;
+
+ unless ( $class->can('new') ) {
+ local $@;
+ eval "require $class";
+ $self->_croak("Can't load $class: $@") if $@;
+ }
+
+ return $class->new(@args);
+}
+
+=head3 C<mk_methods>
+
+Create simple getter/setters.
+
+ __PACKAGE__->mk_methods(@method_names);
+
+=cut
+
+sub mk_methods {
+ my ( $class, @methods ) = @_;
+ for my $method_name (@methods) {
+ my $method = "${class}::$method_name";
+ no strict 'refs';
+ *$method = sub {
+ my $self = shift;
+ $self->{$method_name} = shift if @_;
+ return $self->{$method_name};
+ };
+ }
+}
+
+1;
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser.pm
new file mode 100755
index 0000000000..9283ac3d2f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser.pm
@@ -0,0 +1,1931 @@
+package TAP::Parser;
+
+use strict;
+use warnings;
+
+use TAP::Parser::Grammar ();
+use TAP::Parser::Result ();
+use TAP::Parser::ResultFactory ();
+use TAP::Parser::Source ();
+use TAP::Parser::Iterator ();
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::SourceHandler::Executable ();
+use TAP::Parser::SourceHandler::Perl ();
+use TAP::Parser::SourceHandler::File ();
+use TAP::Parser::SourceHandler::RawTAP ();
+use TAP::Parser::SourceHandler::Handle ();
+
+use Carp qw( confess );
+
+use base 'TAP::Base';
+
+=encoding utf8
+
+=head1 NAME
+
+TAP::Parser - Parse L<TAP|Test::Harness::TAP> output
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+my $DEFAULT_TAP_VERSION = 12;
+my $MAX_TAP_VERSION = 14;
+
+$ENV{TAP_VERSION} = $MAX_TAP_VERSION;
+
+END {
+
+ # For VMS.
+ delete $ENV{TAP_VERSION};
+}
+
+BEGIN { # making accessors
+ __PACKAGE__->mk_methods(
+ qw(
+ _iterator
+ _spool
+ exec
+ exit
+ is_good_plan
+ plan
+ tests_planned
+ tests_run
+ wait
+ version
+ in_todo
+ start_time
+ end_time
+ start_times
+ end_times
+ skip_all
+ grammar_class
+ result_factory_class
+ iterator_factory_class
+ )
+ );
+
+ sub _stream { # deprecated
+ my $self = shift;
+ $self->_iterator(@_);
+ }
+} # done making accessors
+
+=head1 SYNOPSIS
+
+ use TAP::Parser;
+
+ my $parser = TAP::Parser->new( { source => $source } );
+
+ while ( my $result = $parser->next ) {
+ print $result->as_string;
+ }
+
+=head1 DESCRIPTION
+
+C<TAP::Parser> is designed to produce a proper parse of TAP output. For
+an example of how to run tests through this module, see the simple
+harnesses C<examples/>.
+
+There's a wiki dedicated to the Test Anything Protocol:
+
+L<http://testanything.org>
+
+It includes the TAP::Parser Cookbook:
+
+L<http://testanything.org/testing-with-tap/perl/tap::parser-cookbook.html>
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $parser = TAP::Parser->new(\%args);
+
+Returns a new C<TAP::Parser> object.
+
+The arguments should be a hashref with I<one> of the following keys:
+
+=over 4
+
+=item * C<source>
+
+I<CHANGED in 3.18>
+
+This is the preferred method of passing input to the constructor.
+
+The C<source> is used to create a L<TAP::Parser::Source> that is passed to the
+L</iterator_factory_class> which in turn figures out how to handle the source and
+creates a <TAP::Parser::Iterator> for it. The iterator is used by the parser to
+read in the TAP stream.
+
+To configure the I<IteratorFactory> use the C<sources> parameter below.
+
+Note that C<source>, C<tap> and C<exec> are I<mutually exclusive>.
+
+=item * C<tap>
+
+I<CHANGED in 3.18>
+
+The value should be the complete TAP output.
+
+The I<tap> is used to create a L<TAP::Parser::Source> that is passed to the
+L</iterator_factory_class> which in turn figures out how to handle the source and
+creates a <TAP::Parser::Iterator> for it. The iterator is used by the parser to
+read in the TAP stream.
+
+To configure the I<IteratorFactory> use the C<sources> parameter below.
+
+Note that C<source>, C<tap> and C<exec> are I<mutually exclusive>.
+
+=item * C<exec>
+
+Must be passed an array reference.
+
+The I<exec> array ref is used to create a L<TAP::Parser::Source> that is passed
+to the L</iterator_factory_class> which in turn figures out how to handle the
+source and creates a <TAP::Parser::Iterator> for it. The iterator is used by
+the parser to read in the TAP stream.
+
+By default the L<TAP::Parser::SourceHandler::Executable> class will create a
+L<TAP::Parser::Iterator::Process> object to handle the source. This passes the
+array reference strings as command arguments to L<IPC::Open3::open3|IPC::Open3>:
+
+ exec => [ '/usr/bin/ruby', 't/my_test.rb' ]
+
+If any C<test_args> are given they will be appended to the end of the command
+argument list.
+
+To configure the I<IteratorFactory> use the C<sources> parameter below.
+
+Note that C<source>, C<tap> and C<exec> are I<mutually exclusive>.
+
+=back
+
+The following keys are optional.
+
+=over 4
+
+=item * C<sources>
+
+I<NEW to 3.18>.
+
+If set, C<sources> must be a hashref containing the names of the
+L<TAP::Parser::SourceHandler>s to load and/or configure. The values are a
+hash of configuration that will be accessible to the source handlers via
+L<TAP::Parser::Source/config_for>.
+
+For example:
+
+ sources => {
+ Perl => { exec => '/path/to/custom/perl' },
+ File => { extensions => [ '.tap', '.txt' ] },
+ MyCustom => { some => 'config' },
+ }
+
+This will cause C<TAP::Parser> to pass custom configuration to two of the built-
+in source handlers - L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File> - and attempt to load the C<MyCustom>
+class. See L<TAP::Parser::IteratorFactory/load_handlers> for more detail.
+
+The C<sources> parameter affects how C<source>, C<tap> and C<exec> parameters
+are handled.
+
+See L<TAP::Parser::IteratorFactory>, L<TAP::Parser::SourceHandler> and subclasses for
+more details.
+
+=item * C<callback>
+
+If present, each callback corresponding to a given result type will be called
+with the result as the argument if the C<run> method is used:
+
+ my %callbacks = (
+ test => \&test_callback,
+ plan => \&plan_callback,
+ comment => \&comment_callback,
+ bailout => \&bailout_callback,
+ unknown => \&unknown_callback,
+ );
+
+ my $aggregator = TAP::Parser::Aggregator->new;
+ for my $file ( @test_files ) {
+ my $parser = TAP::Parser->new(
+ {
+ source => $file,
+ callbacks => \%callbacks,
+ }
+ );
+ $parser->run;
+ $aggregator->add( $file, $parser );
+ }
+
+=item * C<switches>
+
+If using a Perl file as a source, optional switches may be passed which will
+be used when invoking the perl executable.
+
+ my $parser = TAP::Parser->new( {
+ source => $test_file,
+ switches => [ '-Ilib' ],
+ } );
+
+=item * C<test_args>
+
+Used in conjunction with the C<source> and C<exec> option to supply a reference
+to an C<@ARGV> style array of arguments to pass to the test program.
+
+=item * C<spool>
+
+If passed a filehandle will write a copy of all parsed TAP to that handle.
+
+=item * C<merge>
+
+If false, STDERR is not captured (though it is 'relayed' to keep it
+somewhat synchronized with STDOUT.)
+
+If true, STDERR and STDOUT are the same filehandle. This may cause
+breakage if STDERR contains anything resembling TAP format, but does
+allow exact synchronization.
+
+Subtleties of this behavior may be platform-dependent and may change in
+the future.
+
+=item * C<grammar_class>
+
+This option was introduced to let you easily customize which I<grammar> class
+the parser should use. It defaults to L<TAP::Parser::Grammar>.
+
+See also L</make_grammar>.
+
+=item * C<result_factory_class>
+
+This option was introduced to let you easily customize which I<result>
+factory class the parser should use. It defaults to
+L<TAP::Parser::ResultFactory>.
+
+See also L</make_result>.
+
+=item * C<iterator_factory_class>
+
+I<CHANGED in 3.18>
+
+This option was introduced to let you easily customize which I<iterator>
+factory class the parser should use. It defaults to
+L<TAP::Parser::IteratorFactory>.
+
+=back
+
+=cut
+
+# new() implementation supplied by TAP::Base
+
+# This should make overriding behaviour of the Parser in subclasses easier:
+sub _default_grammar_class {'TAP::Parser::Grammar'}
+sub _default_result_factory_class {'TAP::Parser::ResultFactory'}
+sub _default_iterator_factory_class {'TAP::Parser::IteratorFactory'}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<next>
+
+ my $parser = TAP::Parser->new( { source => $file } );
+ while ( my $result = $parser->next ) {
+ print $result->as_string, "\n";
+ }
+
+This method returns the results of the parsing, one result at a time. Note
+that it is destructive. You can't rewind and examine previous results.
+
+If callbacks are used, they will be issued before this call returns.
+
+Each result returned is a subclass of L<TAP::Parser::Result>. See that
+module and related classes for more information on how to use them.
+
+=cut
+
+sub next {
+ my $self = shift;
+ return ( $self->{_iter} ||= $self->_iter )->();
+}
+
+##############################################################################
+
+=head3 C<run>
+
+ $parser->run;
+
+This method merely runs the parser and parses all of the TAP.
+
+=cut
+
+sub run {
+ my $self = shift;
+ while ( defined( my $result = $self->next ) ) {
+
+ # do nothing
+ }
+}
+
+##############################################################################
+
+=head3 C<make_grammar>
+
+Make a new L<TAP::Parser::Grammar> object and return it. Passes through any
+arguments given.
+
+The C<grammar_class> can be customized, as described in L</new>.
+
+=head3 C<make_result>
+
+Make a new L<TAP::Parser::Result> object using the parser's
+L<TAP::Parser::ResultFactory>, and return it. Passes through any arguments
+given.
+
+The C<result_factory_class> can be customized, as described in L</new>.
+
+=head3 C<make_iterator_factory>
+
+I<NEW to 3.18>.
+
+Make a new L<TAP::Parser::IteratorFactory> object and return it. Passes through
+any arguments given.
+
+C<iterator_factory_class> can be customized, as described in L</new>.
+
+=cut
+
+# This should make overriding behaviour of the Parser in subclasses easier:
+sub make_iterator_factory { shift->iterator_factory_class->new(@_); }
+sub make_grammar { shift->grammar_class->new(@_); }
+sub make_result { shift->result_factory_class->make_result(@_); }
+
+{
+
+ # of the following, anything beginning with an underscore is strictly
+ # internal and should not be exposed.
+ my %initialize = (
+ version => $DEFAULT_TAP_VERSION,
+ plan => '', # the test plan (e.g., 1..3)
+ tests_run => 0, # actual current test numbers
+ skipped => [], #
+ todo => [], #
+ passed => [], #
+ failed => [], #
+ actual_failed => [], # how many tests really failed
+ actual_passed => [], # how many tests really passed
+ todo_passed => [], # tests which unexpectedly succeed
+ parse_errors => [], # perfect TAP should have none
+ );
+
+ # We seem to have this list hanging around all over the place. We could
+ # probably get it from somewhere else to avoid the repetition.
+ my @legal_callback = qw(
+ test
+ version
+ plan
+ comment
+ bailout
+ unknown
+ yaml
+ ALL
+ ELSE
+ EOF
+ );
+
+ my @class_overrides = qw(
+ grammar_class
+ result_factory_class
+ iterator_factory_class
+ );
+
+ sub _initialize {
+ my ( $self, $arg_for ) = @_;
+
+ # everything here is basically designed to convert any TAP source to a
+ # TAP::Parser::Iterator.
+
+ # Shallow copy
+ my %args = %{ $arg_for || {} };
+
+ $self->SUPER::_initialize( \%args, \@legal_callback );
+
+ # get any class overrides out first:
+ for my $key (@class_overrides) {
+ my $default_method = "_default_$key";
+ my $val = delete $args{$key} || $self->$default_method();
+ $self->$key($val);
+ }
+
+ my $iterator = delete $args{iterator};
+ $iterator ||= delete $args{stream}; # deprecated
+ my $tap = delete $args{tap};
+ my $version = delete $args{version};
+ my $raw_source = delete $args{source};
+ my $sources = delete $args{sources};
+ my $exec = delete $args{exec};
+ my $merge = delete $args{merge};
+ my $spool = delete $args{spool};
+ my $switches = delete $args{switches};
+ my $ignore_exit = delete $args{ignore_exit};
+ my $test_args = delete $args{test_args} || [];
+
+ if ( 1 < grep {defined} $iterator, $tap, $raw_source, $exec ) {
+ $self->_croak(
+ "You may only choose one of 'exec', 'tap', 'source' or 'iterator'"
+ );
+ }
+
+ if ( my @excess = sort keys %args ) {
+ $self->_croak("Unknown options: @excess");
+ }
+
+ # convert $tap & $exec to $raw_source equiv.
+ my $type = '';
+ my $source = TAP::Parser::Source->new;
+ if ($tap) {
+ $type = 'raw TAP';
+ $source->raw( \$tap );
+ }
+ elsif ($exec) {
+ $type = 'exec ' . $exec->[0];
+ $source->raw( { exec => $exec } );
+ }
+ elsif ($raw_source) {
+ $type = 'source ' . ref($raw_source) || $raw_source;
+ $source->raw( ref($raw_source) ? $raw_source : \$raw_source );
+ }
+ elsif ($iterator) {
+ $type = 'iterator ' . ref($iterator);
+ }
+
+ if ( $source->raw ) {
+ my $src_factory = $self->make_iterator_factory($sources);
+ $source->merge($merge)->switches($switches)
+ ->test_args($test_args);
+ $iterator = $src_factory->make_iterator($source);
+ }
+
+ unless ($iterator) {
+ $self->_croak(
+ "PANIC: could not determine iterator for input $type");
+ }
+
+ while ( my ( $k, $v ) = each %initialize ) {
+ $self->{$k} = 'ARRAY' eq ref $v ? [] : $v;
+ }
+
+ $self->version($version) if $version;
+ $self->_iterator($iterator);
+ $self->_spool($spool);
+ $self->ignore_exit($ignore_exit);
+
+ return $self;
+ }
+}
+
+=head1 INDIVIDUAL RESULTS
+
+If you've read this far in the docs, you've seen this:
+
+ while ( my $result = $parser->next ) {
+ print $result->as_string;
+ }
+
+Each result returned is a L<TAP::Parser::Result> subclass, referred to as
+I<result types>.
+
+=head2 Result types
+
+Basically, you fetch individual results from the TAP. The six types, with
+examples of each, are as follows:
+
+=over 4
+
+=item * Version
+
+ TAP version 12
+
+=item * Plan
+
+ 1..42
+
+=item * Pragma
+
+ pragma +strict
+
+=item * Test
+
+ ok 3 - We should start with some foobar!
+
+=item * Comment
+
+ # Hope we don't use up the foobar.
+
+=item * Bailout
+
+ Bail out! We ran out of foobar!
+
+=item * Unknown
+
+ ... yo, this ain't TAP! ...
+
+=back
+
+Each result fetched is a result object of a different type. There are common
+methods to each result object and different types may have methods unique to
+their type. Sometimes a type method may be overridden in a subclass, but its
+use is guaranteed to be identical.
+
+=head2 Common type methods
+
+=head3 C<type>
+
+Returns the type of result, such as C<comment> or C<test>.
+
+=head3 C<as_string>
+
+Prints a string representation of the token. This might not be the exact
+output, however. Tests will have test numbers added if not present, TODO and
+SKIP directives will be capitalized and, in general, things will be cleaned
+up. If you need the original text for the token, see the C<raw> method.
+
+=head3 C<raw>
+
+Returns the original line of text which was parsed.
+
+=head3 C<is_plan>
+
+Indicates whether or not this is the test plan line.
+
+=head3 C<is_test>
+
+Indicates whether or not this is a test line.
+
+=head3 C<is_comment>
+
+Indicates whether or not this is a comment. Comments will generally only
+appear in the TAP stream if STDERR is merged to STDOUT. See the
+C<merge> option.
+
+=head3 C<is_bailout>
+
+Indicates whether or not this is bailout line.
+
+=head3 C<is_yaml>
+
+Indicates whether or not the current item is a YAML block.
+
+=head3 C<is_unknown>
+
+Indicates whether or not the current line could be parsed.
+
+=head3 C<is_ok>
+
+ if ( $result->is_ok ) { ... }
+
+Reports whether or not a given result has passed. Anything which is B<not> a
+test result returns true. This is merely provided as a convenient shortcut
+which allows you to do this:
+
+ my $parser = TAP::Parser->new( { source => $source } );
+ while ( my $result = $parser->next ) {
+ # only print failing results
+ print $result->as_string unless $result->is_ok;
+ }
+
+=head2 C<plan> methods
+
+ if ( $result->is_plan ) { ... }
+
+If the above evaluates as true, the following methods will be available on the
+C<$result> object.
+
+=head3 C<plan>
+
+ if ( $result->is_plan ) {
+ print $result->plan;
+ }
+
+This is merely a synonym for C<as_string>.
+
+=head3 C<directive>
+
+ my $directive = $result->directive;
+
+If a SKIP directive is included with the plan, this method will return it.
+
+ 1..0 # SKIP: why bother?
+
+=head3 C<explanation>
+
+ my $explanation = $result->explanation;
+
+If a SKIP directive was included with the plan, this method will return the
+explanation, if any.
+
+=head2 C<pragma> methods
+
+ if ( $result->is_pragma ) { ... }
+
+If the above evaluates as true, the following methods will be available on the
+C<$result> object.
+
+=head3 C<pragmas>
+
+Returns a list of pragmas each of which is a + or - followed by the
+pragma name.
+
+=head2 C<comment> methods
+
+ if ( $result->is_comment ) { ... }
+
+If the above evaluates as true, the following methods will be available on the
+C<$result> object.
+
+=head3 C<comment>
+
+ if ( $result->is_comment ) {
+ my $comment = $result->comment;
+ print "I have something to say: $comment";
+ }
+
+=head2 C<bailout> methods
+
+ if ( $result->is_bailout ) { ... }
+
+If the above evaluates as true, the following methods will be available on the
+C<$result> object.
+
+=head3 C<explanation>
+
+ if ( $result->is_bailout ) {
+ my $explanation = $result->explanation;
+ print "We bailed out because ($explanation)";
+ }
+
+If, and only if, a token is a bailout token, you can get an "explanation" via
+this method. The explanation is the text after the mystical "Bail out!" words
+which appear in the tap output.
+
+=head2 C<unknown> methods
+
+ if ( $result->is_unknown ) { ... }
+
+There are no unique methods for unknown results.
+
+=head2 C<test> methods
+
+ if ( $result->is_test ) { ... }
+
+If the above evaluates as true, the following methods will be available on the
+C<$result> object.
+
+=head3 C<ok>
+
+ my $ok = $result->ok;
+
+Returns the literal text of the C<ok> or C<not ok> status.
+
+=head3 C<number>
+
+ my $test_number = $result->number;
+
+Returns the number of the test, even if the original TAP output did not supply
+that number.
+
+=head3 C<description>
+
+ my $description = $result->description;
+
+Returns the description of the test, if any. This is the portion after the
+test number but before the directive.
+
+=head3 C<directive>
+
+ my $directive = $result->directive;
+
+Returns either C<TODO> or C<SKIP> if either directive was present for a test
+line.
+
+=head3 C<explanation>
+
+ my $explanation = $result->explanation;
+
+If a test had either a C<TODO> or C<SKIP> directive, this method will return
+the accompanying explanation, if present.
+
+ not ok 17 - 'Pigs can fly' # TODO not enough acid
+
+For the above line, the explanation is I<not enough acid>.
+
+=head3 C<is_ok>
+
+ if ( $result->is_ok ) { ... }
+
+Returns a boolean value indicating whether or not the test passed. Remember
+that for TODO tests, the test always passes.
+
+B<Note:> this was formerly C<passed>. The latter method is deprecated and
+will issue a warning.
+
+=head3 C<is_actual_ok>
+
+ if ( $result->is_actual_ok ) { ... }
+
+Returns a boolean value indicating whether or not the test passed, regardless
+of its TODO status.
+
+B<Note:> this was formerly C<actual_passed>. The latter method is deprecated
+and will issue a warning.
+
+=head3 C<is_unplanned>
+
+ if ( $test->is_unplanned ) { ... }
+
+If a test number is greater than the number of planned tests, this method will
+return true. Unplanned tests will I<always> return false for C<is_ok>,
+regardless of whether or not the test C<has_todo> (see
+L<TAP::Parser::Result::Test> for more information about this).
+
+=head3 C<has_skip>
+
+ if ( $result->has_skip ) { ... }
+
+Returns a boolean value indicating whether or not this test had a SKIP
+directive.
+
+=head3 C<has_todo>
+
+ if ( $result->has_todo ) { ... }
+
+Returns a boolean value indicating whether or not this test had a TODO
+directive.
+
+Note that TODO tests I<always> pass. If you need to know whether or not
+they really passed, check the C<is_actual_ok> method.
+
+=head3 C<in_todo>
+
+ if ( $parser->in_todo ) { ... }
+
+True while the most recent result was a TODO. Becomes true before the
+TODO result is returned and stays true until just before the next non-
+TODO test is returned.
+
+=head1 TOTAL RESULTS
+
+After parsing the TAP, there are many methods available to let you dig through
+the results and determine what is meaningful to you.
+
+=head2 Individual Results
+
+These results refer to individual tests which are run.
+
+=head3 C<passed>
+
+ my @passed = $parser->passed; # the test numbers which passed
+ my $passed = $parser->passed; # the number of tests which passed
+
+This method lets you know which (or how many) tests passed. If a test failed
+but had a TODO directive, it will be counted as a passed test.
+
+=cut
+
+sub passed {
+ return @{ $_[0]->{passed} }
+ if ref $_[0]->{passed};
+ return wantarray ? 1 .. $_[0]->{passed} : $_[0]->{passed};
+}
+
+=head3 C<failed>
+
+ my @failed = $parser->failed; # the test numbers which failed
+ my $failed = $parser->failed; # the number of tests which failed
+
+This method lets you know which (or how many) tests failed. If a test passed
+but had a TODO directive, it will B<NOT> be counted as a failed test.
+
+=cut
+
+sub failed { @{ shift->{failed} } }
+
+=head3 C<actual_passed>
+
+ # the test numbers which actually passed
+ my @actual_passed = $parser->actual_passed;
+
+ # the number of tests which actually passed
+ my $actual_passed = $parser->actual_passed;
+
+This method lets you know which (or how many) tests actually passed,
+regardless of whether or not a TODO directive was found.
+
+=cut
+
+sub actual_passed {
+ return @{ $_[0]->{actual_passed} }
+ if ref $_[0]->{actual_passed};
+ return wantarray ? 1 .. $_[0]->{actual_passed} : $_[0]->{actual_passed};
+}
+*actual_ok = \&actual_passed;
+
+=head3 C<actual_ok>
+
+This method is a synonym for C<actual_passed>.
+
+=head3 C<actual_failed>
+
+ # the test numbers which actually failed
+ my @actual_failed = $parser->actual_failed;
+
+ # the number of tests which actually failed
+ my $actual_failed = $parser->actual_failed;
+
+This method lets you know which (or how many) tests actually failed,
+regardless of whether or not a TODO directive was found.
+
+=cut
+
+sub actual_failed { @{ shift->{actual_failed} } }
+
+##############################################################################
+
+=head3 C<todo>
+
+ my @todo = $parser->todo; # the test numbers with todo directives
+ my $todo = $parser->todo; # the number of tests with todo directives
+
+This method lets you know which (or how many) tests had TODO directives.
+
+=cut
+
+sub todo { @{ shift->{todo} } }
+
+=head3 C<todo_passed>
+
+ # the test numbers which unexpectedly succeeded
+ my @todo_passed = $parser->todo_passed;
+
+ # the number of tests which unexpectedly succeeded
+ my $todo_passed = $parser->todo_passed;
+
+This method lets you know which (or how many) tests actually passed but were
+declared as "TODO" tests.
+
+=cut
+
+sub todo_passed { @{ shift->{todo_passed} } }
+
+##############################################################################
+
+=head3 C<todo_failed>
+
+ # deprecated in favor of 'todo_passed'. This method was horribly misnamed.
+
+This was a badly misnamed method. It indicates which TODO tests unexpectedly
+succeeded. Will now issue a warning and call C<todo_passed>.
+
+=cut
+
+sub todo_failed {
+ warn
+ '"todo_failed" is deprecated. Please use "todo_passed". See the docs.';
+ goto &todo_passed;
+}
+
+=head3 C<skipped>
+
+ my @skipped = $parser->skipped; # the test numbers with SKIP directives
+ my $skipped = $parser->skipped; # the number of tests with SKIP directives
+
+This method lets you know which (or how many) tests had SKIP directives.
+
+=cut
+
+sub skipped { @{ shift->{skipped} } }
+
+=head2 Pragmas
+
+=head3 C<pragma>
+
+Get or set a pragma. To get the state of a pragma:
+
+ if ( $p->pragma('strict') ) {
+ # be strict
+ }
+
+To set the state of a pragma:
+
+ $p->pragma('strict', 1); # enable strict mode
+
+=cut
+
+sub pragma {
+ my ( $self, $pragma ) = splice @_, 0, 2;
+
+ return $self->{pragma}->{$pragma} unless @_;
+
+ if ( my $state = shift ) {
+ $self->{pragma}->{$pragma} = 1;
+ }
+ else {
+ delete $self->{pragma}->{$pragma};
+ }
+
+ return;
+}
+
+=head3 C<pragmas>
+
+Get a list of all the currently enabled pragmas:
+
+ my @pragmas_enabled = $p->pragmas;
+
+=cut
+
+sub pragmas { sort keys %{ shift->{pragma} || {} } }
+
+=head2 Summary Results
+
+These results are "meta" information about the total results of an individual
+test program.
+
+=head3 C<plan>
+
+ my $plan = $parser->plan;
+
+Returns the test plan, if found.
+
+=head3 C<good_plan>
+
+Deprecated. Use C<is_good_plan> instead.
+
+=cut
+
+sub good_plan {
+ warn 'good_plan() is deprecated. Please use "is_good_plan()"';
+ goto &is_good_plan;
+}
+
+##############################################################################
+
+=head3 C<is_good_plan>
+
+ if ( $parser->is_good_plan ) { ... }
+
+Returns a boolean value indicating whether or not the number of tests planned
+matches the number of tests run.
+
+B<Note:> this was formerly C<good_plan>. The latter method is deprecated and
+will issue a warning.
+
+And since we're on that subject ...
+
+=head3 C<tests_planned>
+
+ print $parser->tests_planned;
+
+Returns the number of tests planned, according to the plan. For example, a
+plan of '1..17' will mean that 17 tests were planned.
+
+=head3 C<tests_run>
+
+ print $parser->tests_run;
+
+Returns the number of tests which actually were run. Hopefully this will
+match the number of C<< $parser->tests_planned >>.
+
+=head3 C<skip_all>
+
+Returns a true value (actually the reason for skipping) if all tests
+were skipped.
+
+=head3 C<start_time>
+
+Returns the wall-clock time when the Parser was created.
+
+=head3 C<end_time>
+
+Returns the wall-clock time when the end of TAP input was seen.
+
+=head3 C<start_times>
+
+Returns the CPU times (like L<perlfunc/times> when the Parser was created.
+
+=head3 C<end_times>
+
+Returns the CPU times (like L<perlfunc/times> when the end of TAP
+input was seen.
+
+=head3 C<has_problems>
+
+ if ( $parser->has_problems ) {
+ ...
+ }
+
+This is a 'catch-all' method which returns true if any tests have currently
+failed, any TODO tests unexpectedly succeeded, or any parse errors occurred.
+
+=cut
+
+sub has_problems {
+ my $self = shift;
+ return
+ $self->failed
+ || $self->parse_errors
+ || ( !$self->ignore_exit && ( $self->wait || $self->exit ) );
+}
+
+=head3 C<version>
+
+ $parser->version;
+
+Once the parser is done, this will return the version number for the
+parsed TAP. Version numbers were introduced with TAP version 13 so if no
+version number is found version 12 is assumed.
+
+=head3 C<exit>
+
+ $parser->exit;
+
+Once the parser is done, this will return the exit status. If the parser ran
+an executable, it returns the exit status of the executable.
+
+=head3 C<wait>
+
+ $parser->wait;
+
+Once the parser is done, this will return the wait status. If the parser ran
+an executable, it returns the wait status of the executable. Otherwise, this
+merely returns the C<exit> status.
+
+=head2 C<ignore_exit>
+
+ $parser->ignore_exit(1);
+
+Tell the parser to ignore the exit status from the test when determining
+whether the test passed. Normally tests with non-zero exit status are
+considered to have failed even if all individual tests passed. In cases
+where it is not possible to control the exit value of the test script
+use this option to ignore it.
+
+=cut
+
+sub ignore_exit { shift->pragma( 'ignore_exit', @_ ) }
+
+=head3 C<parse_errors>
+
+ my @errors = $parser->parse_errors; # the parser errors
+ my $errors = $parser->parse_errors; # the number of parser_errors
+
+Fortunately, all TAP output is perfect. In the event that it is not, this
+method will return parser errors. Note that a junk line which the parser does
+not recognize is C<not> an error. This allows this parser to handle future
+versions of TAP. The following are all TAP errors reported by the parser:
+
+=over 4
+
+=item * Misplaced plan
+
+The plan (for example, '1..5'), must only come at the beginning or end of the
+TAP output.
+
+=item * No plan
+
+Gotta have a plan!
+
+=item * More than one plan
+
+ 1..3
+ ok 1 - input file opened
+ not ok 2 - first line of the input valid # todo some data
+ ok 3 read the rest of the file
+ 1..3
+
+Right. Very funny. Don't do that.
+
+=item * Test numbers out of sequence
+
+ 1..3
+ ok 1 - input file opened
+ not ok 2 - first line of the input valid # todo some data
+ ok 2 read the rest of the file
+
+That last test line above should have the number '3' instead of '2'.
+
+Note that it's perfectly acceptable for some lines to have test numbers and
+others to not have them. However, when a test number is found, it must be in
+sequence. The following is also an error:
+
+ 1..3
+ ok 1 - input file opened
+ not ok - first line of the input valid # todo some data
+ ok 2 read the rest of the file
+
+But this is not:
+
+ 1..3
+ ok - input file opened
+ not ok - first line of the input valid # todo some data
+ ok 3 read the rest of the file
+
+=back
+
+=cut
+
+sub parse_errors { @{ shift->{parse_errors} } }
+
+sub _add_error {
+ my ( $self, $error ) = @_;
+ push @{ $self->{parse_errors} } => $error;
+ return $self;
+}
+
+sub _make_state_table {
+ my $self = shift;
+ my %states;
+ my %planned_todo = ();
+
+ # These transitions are defaults for all states
+ my %state_globals = (
+ comment => {},
+ bailout => {},
+ yaml => {},
+ version => {
+ act => sub {
+ $self->_add_error(
+ 'If TAP version is present it must be the first line of output'
+ );
+ },
+ },
+ unknown => {
+ act => sub {
+ my $unk = shift;
+ if ( $self->pragma('strict') ) {
+ $self->_add_error(
+ 'Unknown TAP token: "' . $unk->raw . '"' );
+ }
+ },
+ },
+ pragma => {
+ act => sub {
+ my ($pragma) = @_;
+ for my $pr ( $pragma->pragmas ) {
+ if ( $pr =~ /^ ([-+])(\w+) $/x ) {
+ $self->pragma( $2, $1 eq '+' );
+ }
+ }
+ },
+ },
+ );
+
+ # Provides default elements for transitions
+ my %state_defaults = (
+ plan => {
+ act => sub {
+ my ($plan) = @_;
+ $self->tests_planned( $plan->tests_planned );
+ $self->plan( $plan->plan );
+ if ( $plan->has_skip ) {
+ $self->skip_all( $plan->explanation
+ || '(no reason given)' );
+ }
+
+ $planned_todo{$_}++ for @{ $plan->todo_list };
+ },
+ },
+ test => {
+ act => sub {
+ my ($test) = @_;
+
+ my ( $number, $tests_run )
+ = ( $test->number, ++$self->{tests_run} );
+
+ # Fake TODO state
+ if ( defined $number && delete $planned_todo{$number} ) {
+ $test->set_directive('TODO');
+ }
+
+ my $has_todo = $test->has_todo;
+
+ $self->in_todo($has_todo);
+ if ( defined( my $tests_planned = $self->tests_planned ) ) {
+ if ( $tests_run > $tests_planned ) {
+ $test->is_unplanned(1);
+ }
+ }
+
+ if ( defined $number ) {
+ if ( $number != $tests_run ) {
+ my $count = $tests_run;
+ $self->_add_error( "Tests out of sequence. Found "
+ . "($number) but expected ($count)" );
+ }
+ }
+ else {
+ $test->_number( $number = $tests_run );
+ }
+
+ push @{ $self->{todo} } => $number if $has_todo;
+ push @{ $self->{todo_passed} } => $number
+ if $test->todo_passed;
+ push @{ $self->{skipped} } => $number
+ if $test->has_skip;
+
+ push @{ $self->{ $test->is_ok ? 'passed' : 'failed' } } =>
+ $number;
+ push @{
+ $self->{
+ $test->is_actual_ok
+ ? 'actual_passed'
+ : 'actual_failed'
+ }
+ } => $number;
+ },
+ },
+ yaml => { act => sub { }, },
+ );
+
+ # Each state contains a hash the keys of which match a token type. For
+ # each token
+ # type there may be:
+ # act A coderef to run
+ # goto The new state to move to. Stay in this state if
+ # missing
+ # continue Goto the new state and run the new state for the
+ # current token
+ %states = (
+ INIT => {
+ version => {
+ act => sub {
+ my ($version) = @_;
+ my $ver_num = $version->version;
+ if ( $ver_num <= $DEFAULT_TAP_VERSION ) {
+ my $ver_min = $DEFAULT_TAP_VERSION + 1;
+ $self->_add_error(
+ "Explicit TAP version must be at least "
+ . "$ver_min. Got version $ver_num" );
+ $ver_num = $DEFAULT_TAP_VERSION;
+ }
+ if ( $ver_num > $MAX_TAP_VERSION ) {
+ $self->_add_error(
+ "TAP specified version $ver_num but "
+ . "we don't know about versions later "
+ . "than $MAX_TAP_VERSION" );
+ $ver_num = $MAX_TAP_VERSION;
+ }
+ $self->version($ver_num);
+ $self->_grammar->set_version($ver_num);
+ },
+ goto => 'PLAN'
+ },
+ plan => { goto => 'PLANNED' },
+ test => { goto => 'UNPLANNED' },
+ },
+ PLAN => {
+ plan => { goto => 'PLANNED' },
+ test => { goto => 'UNPLANNED' },
+ },
+ PLANNED => {
+ test => { goto => 'PLANNED_AFTER_TEST' },
+ plan => {
+ act => sub {
+ my ($version) = @_;
+ $self->_add_error(
+ 'More than one plan found in TAP output');
+ },
+ },
+ },
+ PLANNED_AFTER_TEST => {
+ test => { goto => 'PLANNED_AFTER_TEST' },
+ plan => { act => sub { }, continue => 'PLANNED' },
+ yaml => { goto => 'PLANNED' },
+ },
+ GOT_PLAN => {
+ test => {
+ act => sub {
+ my ($plan) = @_;
+ my $line = $self->plan;
+ $self->_add_error(
+ "Plan ($line) must be at the beginning "
+ . "or end of the TAP output" );
+ $self->is_good_plan(0);
+ },
+ continue => 'PLANNED'
+ },
+ plan => { continue => 'PLANNED' },
+ },
+ UNPLANNED => {
+ test => { goto => 'UNPLANNED_AFTER_TEST' },
+ plan => { goto => 'GOT_PLAN' },
+ },
+ UNPLANNED_AFTER_TEST => {
+ test => { act => sub { }, continue => 'UNPLANNED' },
+ plan => { act => sub { }, continue => 'UNPLANNED' },
+ yaml => { goto => 'UNPLANNED' },
+ },
+ );
+
+ # Apply globals and defaults to state table
+ for my $name ( keys %states ) {
+
+ # Merge with globals
+ my $st = { %state_globals, %{ $states{$name} } };
+
+ # Add defaults
+ for my $next ( sort keys %{$st} ) {
+ if ( my $default = $state_defaults{$next} ) {
+ for my $def ( sort keys %{$default} ) {
+ $st->{$next}->{$def} ||= $default->{$def};
+ }
+ }
+ }
+
+ # Stuff back in table
+ $states{$name} = $st;
+ }
+
+ return \%states;
+}
+
+=head3 C<get_select_handles>
+
+Get an a list of file handles which can be passed to C<select> to
+determine the readiness of this parser.
+
+=cut
+
+sub get_select_handles { shift->_iterator->get_select_handles }
+
+sub _grammar {
+ my $self = shift;
+ return $self->{_grammar} = shift if @_;
+
+ return $self->{_grammar} ||= $self->make_grammar(
+ { iterator => $self->_iterator,
+ parser => $self,
+ version => $self->version
+ }
+ );
+}
+
+sub _iter {
+ my $self = shift;
+ my $iterator = $self->_iterator;
+ my $grammar = $self->_grammar;
+ my $spool = $self->_spool;
+ my $state = 'INIT';
+ my $state_table = $self->_make_state_table;
+
+ $self->start_time( $self->get_time ) unless $self->{start_time};
+ $self->start_times( $self->get_times ) unless $self->{start_times};
+
+ # Make next_state closure
+ my $next_state = sub {
+ my $token = shift;
+ my $type = $token->type;
+ TRANS: {
+ my $state_spec = $state_table->{$state}
+ or die "Illegal state: $state";
+
+ if ( my $next = $state_spec->{$type} ) {
+ if ( my $act = $next->{act} ) {
+ $act->($token);
+ }
+ if ( my $cont = $next->{continue} ) {
+ $state = $cont;
+ redo TRANS;
+ }
+ elsif ( my $goto = $next->{goto} ) {
+ $state = $goto;
+ }
+ }
+ else {
+ confess("Unhandled token type: $type\n");
+ }
+ }
+ return $token;
+ };
+
+ # Handle end of stream - which means either pop a block or finish
+ my $end_handler = sub {
+ $self->exit( $iterator->exit );
+ $self->wait( $iterator->wait );
+ $self->_finish;
+ return;
+ };
+
+ # Finally make the closure that we return. For performance reasons
+ # there are two versions of the returned function: one that handles
+ # callbacks and one that does not.
+ if ( $self->_has_callbacks ) {
+ return sub {
+ my $result = eval { $grammar->tokenize };
+ $self->_add_error($@) if $@;
+
+ if ( defined $result ) {
+ $result = $next_state->($result);
+
+ if ( my $code = $self->_callback_for( $result->type ) ) {
+ $_->($result) for @{$code};
+ }
+ else {
+ $self->_make_callback( 'ELSE', $result );
+ }
+
+ $self->_make_callback( 'ALL', $result );
+
+ # Echo TAP to spool file
+ print {$spool} $result->raw, "\n" if $spool;
+ }
+ else {
+ $result = $end_handler->();
+ $self->_make_callback( 'EOF', $self )
+ unless defined $result;
+ }
+
+ return $result;
+ };
+ } # _has_callbacks
+ else {
+ return sub {
+ my $result = eval { $grammar->tokenize };
+ $self->_add_error($@) if $@;
+
+ if ( defined $result ) {
+ $result = $next_state->($result);
+
+ # Echo TAP to spool file
+ print {$spool} $result->raw, "\n" if $spool;
+ }
+ else {
+ $result = $end_handler->();
+ }
+
+ return $result;
+ };
+ } # no callbacks
+}
+
+sub _finish {
+ my $self = shift;
+
+ $self->end_time( $self->get_time );
+ $self->end_times( $self->get_times );
+
+ # Avoid leaks
+ $self->_iterator(undef);
+ $self->_grammar(undef);
+
+ # If we just delete the iter we won't get a fault if it's recreated.
+ # Instead we set it to a sub that returns an infinite
+ # stream of undef. This segfaults on 5.5.4, presumably because
+ # we're still executing the closure that gets replaced and it hasn't
+ # been protected with a refcount.
+ $self->{_iter} = sub {return}
+ if $] >= 5.006;
+
+ # sanity checks
+ if ( !$self->plan ) {
+ $self->_add_error('No plan found in TAP output');
+ }
+ else {
+ $self->is_good_plan(1) unless defined $self->is_good_plan;
+ }
+ if ( $self->tests_run != ( $self->tests_planned || 0 ) ) {
+ $self->is_good_plan(0);
+ if ( defined( my $planned = $self->tests_planned ) ) {
+ my $ran = $self->tests_run;
+ $self->_add_error(
+ "Bad plan. You planned $planned tests but ran $ran.");
+ }
+ }
+ if ( $self->tests_run != ( $self->passed + $self->failed ) ) {
+
+ # this should never happen
+ my $actual = $self->tests_run;
+ my $passed = $self->passed;
+ my $failed = $self->failed;
+ $self->_croak( "Panic: planned test count ($actual) did not equal "
+ . "sum of passed ($passed) and failed ($failed) tests!" );
+ }
+
+ $self->is_good_plan(0) unless defined $self->is_good_plan;
+
+ unless ( $self->parse_errors ) {
+ # Optimise storage where possible
+ if ( $self->tests_run == @{$self->{passed}} ) {
+ $self->{passed} = $self->tests_run;
+ }
+ if ( $self->tests_run == @{$self->{actual_passed}} ) {
+ $self->{actual_passed} = $self->tests_run;
+ }
+ }
+
+ return $self;
+}
+
+=head3 C<delete_spool>
+
+Delete and return the spool.
+
+ my $fh = $parser->delete_spool;
+
+=cut
+
+sub delete_spool {
+ my $self = shift;
+
+ return delete $self->{_spool};
+}
+
+##############################################################################
+
+=head1 CALLBACKS
+
+As mentioned earlier, a "callback" key may be added to the
+C<TAP::Parser> constructor. If present, each callback corresponding to a
+given result type will be called with the result as the argument if the
+C<run> method is used. The callback is expected to be a subroutine
+reference (or anonymous subroutine) which is invoked with the parser
+result as its argument.
+
+ my %callbacks = (
+ test => \&test_callback,
+ plan => \&plan_callback,
+ comment => \&comment_callback,
+ bailout => \&bailout_callback,
+ unknown => \&unknown_callback,
+ );
+
+ my $aggregator = TAP::Parser::Aggregator->new;
+ for my $file ( @test_files ) {
+ my $parser = TAP::Parser->new(
+ {
+ source => $file,
+ callbacks => \%callbacks,
+ }
+ );
+ $parser->run;
+ $aggregator->add( $file, $parser );
+ }
+
+Callbacks may also be added like this:
+
+ $parser->callback( test => \&test_callback );
+ $parser->callback( plan => \&plan_callback );
+
+The following keys allowed for callbacks. These keys are case-sensitive.
+
+=over 4
+
+=item * C<test>
+
+Invoked if C<< $result->is_test >> returns true.
+
+=item * C<version>
+
+Invoked if C<< $result->is_version >> returns true.
+
+=item * C<plan>
+
+Invoked if C<< $result->is_plan >> returns true.
+
+=item * C<comment>
+
+Invoked if C<< $result->is_comment >> returns true.
+
+=item * C<bailout>
+
+Invoked if C<< $result->is_unknown >> returns true.
+
+=item * C<yaml>
+
+Invoked if C<< $result->is_yaml >> returns true.
+
+=item * C<unknown>
+
+Invoked if C<< $result->is_unknown >> returns true.
+
+=item * C<ELSE>
+
+If a result does not have a callback defined for it, this callback will
+be invoked. Thus, if all of the previous result types are specified as
+callbacks, this callback will I<never> be invoked.
+
+=item * C<ALL>
+
+This callback will always be invoked and this will happen for each
+result after one of the above callbacks is invoked. For example, if
+L<Term::ANSIColor> is loaded, you could use the following to color your
+test output:
+
+ my %callbacks = (
+ test => sub {
+ my $test = shift;
+ if ( $test->is_ok && not $test->directive ) {
+ # normal passing test
+ print color 'green';
+ }
+ elsif ( !$test->is_ok ) { # even if it's TODO
+ print color 'white on_red';
+ }
+ elsif ( $test->has_skip ) {
+ print color 'white on_blue';
+
+ }
+ elsif ( $test->has_todo ) {
+ print color 'white';
+ }
+ },
+ ELSE => sub {
+ # plan, comment, and so on (anything which isn't a test line)
+ print color 'black on_white';
+ },
+ ALL => sub {
+ # now print them
+ print shift->as_string;
+ print color 'reset';
+ print "\n";
+ },
+ );
+
+=item * C<EOF>
+
+Invoked when there are no more lines to be parsed. Since there is no
+accompanying L<TAP::Parser::Result> object the C<TAP::Parser> object is
+passed instead.
+
+=back
+
+=head1 TAP GRAMMAR
+
+If you're looking for an EBNF grammar, see L<TAP::Parser::Grammar>.
+
+=head1 BACKWARDS COMPATIBILITY
+
+The Perl-QA list attempted to ensure backwards compatibility with
+L<Test::Harness>. However, there are some minor differences.
+
+=head2 Differences
+
+=over 4
+
+=item * TODO plans
+
+A little-known feature of L<Test::Harness> is that it supported TODO
+lists in the plan:
+
+ 1..2 todo 2
+ ok 1 - We have liftoff
+ not ok 2 - Anti-gravity device activated
+
+Under L<Test::Harness>, test number 2 would I<pass> because it was
+listed as a TODO test on the plan line. However, we are not aware of
+anyone actually using this feature and hard-coding test numbers is
+discouraged because it's very easy to add a test and break the test
+number sequence. This makes test suites very fragile. Instead, the
+following should be used:
+
+ 1..2
+ ok 1 - We have liftoff
+ not ok 2 - Anti-gravity device activated # TODO
+
+=item * 'Missing' tests
+
+It rarely happens, but sometimes a harness might encounter
+'missing tests:
+
+ ok 1
+ ok 2
+ ok 15
+ ok 16
+ ok 17
+
+L<Test::Harness> would report tests 3-14 as having failed. For the
+C<TAP::Parser>, these tests are not considered failed because they've
+never run. They're reported as parse failures (tests out of sequence).
+
+=back
+
+=head1 SUBCLASSING
+
+If you find you need to provide custom functionality (as you would have using
+L<Test::Harness::Straps>), you're in luck: C<TAP::Parser> and friends are
+designed to be easily plugged-into and/or subclassed.
+
+Before you start, it's important to know a few things:
+
+=over 2
+
+=item 1
+
+All C<TAP::*> objects inherit from L<TAP::Object>.
+
+=item 2
+
+Many C<TAP::*> classes have a I<SUBCLASSING> section to guide you.
+
+=item 3
+
+Note that C<TAP::Parser> is designed to be the central "maker" - ie: it is
+responsible for creating most new objects in the C<TAP::Parser::*> namespace.
+
+This makes it possible for you to have a single point of configuring what
+subclasses should be used, which means that in many cases you'll find
+you only need to sub-class one of the parser's components.
+
+The exception to this rule are I<SourceHandlers> & I<Iterators>, but those are
+both created with customizable I<IteratorFactory>.
+
+=item 4
+
+By subclassing, you may end up overriding undocumented methods. That's not
+a bad thing per se, but be forewarned that undocumented methods may change
+without warning from one release to the next - we cannot guarantee backwards
+compatibility. If any I<documented> method needs changing, it will be
+deprecated first, and changed in a later release.
+
+=back
+
+=head2 Parser Components
+
+=head3 Sources
+
+A TAP parser consumes input from a single I<raw source> of TAP, which could come
+from anywhere (a file, an executable, a database, an IO handle, a URI, etc..).
+The source gets bundled up in a L<TAP::Parser::Source> object which gathers some
+meta data about it. The parser then uses a L<TAP::Parser::IteratorFactory> to
+determine which L<TAP::Parser::SourceHandler> to use to turn the raw source
+into a stream of TAP by way of L</Iterators>.
+
+If you simply want C<TAP::Parser> to handle a new source of TAP you probably
+don't need to subclass C<TAP::Parser> itself. Rather, you'll need to create a
+new L<TAP::Parser::SourceHandler> class, and just plug it into the parser using
+the I<sources> param to L</new>. Before you start writing one, read through
+L<TAP::Parser::IteratorFactory> to get a feel for how the system works first.
+
+If you find you really need to use your own iterator factory you can still do
+so without sub-classing C<TAP::Parser> by setting L</iterator_factory_class>.
+
+If you just need to customize the objects on creation, subclass L<TAP::Parser>
+and override L</make_iterator_factory>.
+
+Note that C<make_source> & C<make_perl_source> have been I<DEPRECATED> and
+are now removed.
+
+=head3 Iterators
+
+A TAP parser uses I<iterators> to loop through the I<stream> of TAP read in
+from the I<source> it was given. There are a few types of Iterators available
+by default, all sub-classes of L<TAP::Parser::Iterator>. Choosing which
+iterator to use is the responsibility of the I<iterator factory>, though it
+simply delegates to the I<Source Handler> it uses.
+
+If you're writing your own L<TAP::Parser::SourceHandler>, you may need to
+create your own iterators too. If so you'll need to subclass
+L<TAP::Parser::Iterator>.
+
+Note that L</make_iterator> has been I<DEPRECATED> and is now removed.
+
+=head3 Results
+
+A TAP parser creates L<TAP::Parser::Result>s as it iterates through the
+input I<stream>. There are quite a few result types available; choosing
+which class to use is the responsibility of the I<result factory>.
+
+To create your own result types you have two options:
+
+=over 2
+
+=item option 1
+
+Subclass L<TAP::Parser::Result> and register your new result type/class with
+the default L<TAP::Parser::ResultFactory>.
+
+=item option 2
+
+Subclass L<TAP::Parser::ResultFactory> itself and implement your own
+L<TAP::Parser::Result> creation logic. Then you'll need to customize the
+class used by your parser by setting the C<result_factory_class> parameter.
+See L</new> for more details.
+
+=back
+
+If you need to customize the objects on creation, subclass L<TAP::Parser> and
+override L</make_result>.
+
+=head3 Grammar
+
+L<TAP::Parser::Grammar> is the heart of the parser. It tokenizes the TAP
+input I<stream> and produces results. If you need to customize its behaviour
+you should probably familiarize yourself with the source first. Enough
+lecturing.
+
+Subclass L<TAP::Parser::Grammar> and customize your parser by setting the
+C<grammar_class> parameter. See L</new> for more details.
+
+If you need to customize the objects on creation, subclass L<TAP::Parser> and
+override L</make_grammar>
+
+=head1 ACKNOWLEDGMENTS
+
+All of the following have helped. Bug reports, patches, (im)moral
+support, or just words of encouragement have all been forthcoming.
+
+=over 4
+
+=item * Michael Schwern
+
+=item * Andy Lester
+
+=item * chromatic
+
+=item * GEOFFR
+
+=item * Shlomi Fish
+
+=item * Torsten Schoenfeld
+
+=item * Jerry Gay
+
+=item * Aristotle
+
+=item * Adam Kennedy
+
+=item * Yves Orton
+
+=item * Adrian Howard
+
+=item * Sean & Lil
+
+=item * Andreas J. Koenig
+
+=item * Florian Ragwitz
+
+=item * Corion
+
+=item * Mark Stosberg
+
+=item * Matt Kraai
+
+=item * David Wheeler
+
+=item * Alex Vandiver
+
+=item * Cosimo Streppone
+
+=item * Ville Skyttä
+
+=back
+
+=head1 AUTHORS
+
+Curtis "Ovid" Poe <ovid@cpan.org>
+
+Andy Armstong <andy@hexten.net>
+
+Eric Wilhelm @ <ewilhelm at cpan dot org>
+
+Michael Peters <mpeters at plusthree dot com>
+
+Leif Eriksen <leif dot eriksen at bigpond dot com>
+
+Steve Purkis <spurkis@cpan.org>
+
+Nicholas Clark <nick@ccl4.org>
+
+Lee Johnson <notfadeaway at btinternet dot com>
+
+Philippe Bruhat <book@cpan.org>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-test-harness@rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>.
+We will be notified, and then you'll automatically be notified of
+progress on your bug as we make changes.
+
+Obviously, bugs which include patches are best. If you prefer, you can
+patch against bleed by via anonymous checkout of the latest version:
+
+ git clone git://github.com/Perl-Toolchain-Gang/Test-Harness.git
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2006-2008 Curtis "Ovid" Poe, all rights reserved.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Aggregator.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Aggregator.pm
new file mode 100755
index 0000000000..dac0f9a43e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Aggregator.pm
@@ -0,0 +1,414 @@
+package TAP::Parser::Aggregator;
+
+use strict;
+use warnings;
+use Benchmark;
+
+use base 'TAP::Object';
+
+=head1 NAME
+
+TAP::Parser::Aggregator - Aggregate TAP::Parser results
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Aggregator;
+
+ my $aggregate = TAP::Parser::Aggregator->new;
+ $aggregate->add( 't/00-load.t', $load_parser );
+ $aggregate->add( 't/10-lex.t', $lex_parser );
+
+ my $summary = <<'END_SUMMARY';
+ Passed: %s
+ Failed: %s
+ Unexpectedly succeeded: %s
+ END_SUMMARY
+ printf $summary,
+ scalar $aggregate->passed,
+ scalar $aggregate->failed,
+ scalar $aggregate->todo_passed;
+
+=head1 DESCRIPTION
+
+C<TAP::Parser::Aggregator> collects parser objects and allows
+reporting/querying their aggregate results.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $aggregate = TAP::Parser::Aggregator->new;
+
+Returns a new C<TAP::Parser::Aggregator> object.
+
+=cut
+
+# new() implementation supplied by TAP::Object
+
+my %SUMMARY_METHOD_FOR;
+
+BEGIN { # install summary methods
+ %SUMMARY_METHOD_FOR = map { $_ => $_ } qw(
+ failed
+ parse_errors
+ passed
+ skipped
+ todo
+ todo_passed
+ total
+ wait
+ exit
+ );
+ $SUMMARY_METHOD_FOR{total} = 'tests_run';
+ $SUMMARY_METHOD_FOR{planned} = 'tests_planned';
+
+ for my $method ( keys %SUMMARY_METHOD_FOR ) {
+ next if 'total' eq $method;
+ no strict 'refs';
+ *$method = sub {
+ my $self = shift;
+ return wantarray
+ ? @{ $self->{"descriptions_for_$method"} }
+ : $self->{$method};
+ };
+ }
+} # end install summary methods
+
+sub _initialize {
+ my ($self) = @_;
+ $self->{parser_for} = {};
+ $self->{parse_order} = [];
+ for my $summary ( keys %SUMMARY_METHOD_FOR ) {
+ $self->{$summary} = 0;
+ next if 'total' eq $summary;
+ $self->{"descriptions_for_$summary"} = [];
+ }
+ return $self;
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<add>
+
+ $aggregate->add( $description => $parser );
+
+The C<$description> is usually a test file name (but only by
+convention.) It is used as a unique identifier (see e.g.
+L<"parsers">.) Reusing a description is a fatal error.
+
+The C<$parser> is a L<TAP::Parser|TAP::Parser> object.
+
+=cut
+
+sub add {
+ my ( $self, $description, $parser ) = @_;
+ if ( exists $self->{parser_for}{$description} ) {
+ $self->_croak( "You already have a parser for ($description)."
+ . " Perhaps you have run the same test twice." );
+ }
+ push @{ $self->{parse_order} } => $description;
+ $self->{parser_for}{$description} = $parser;
+
+ while ( my ( $summary, $method ) = each %SUMMARY_METHOD_FOR ) {
+
+ # Slightly nasty. Instead we should maybe have 'cooked' accessors
+ # for results that may be masked by the parser.
+ next
+ if ( $method eq 'exit' || $method eq 'wait' )
+ && $parser->ignore_exit;
+
+ if ( my $count = $parser->$method() ) {
+ $self->{$summary} += $count;
+ push @{ $self->{"descriptions_for_$summary"} } => $description;
+ }
+ }
+
+ return $self;
+}
+
+##############################################################################
+
+=head3 C<parsers>
+
+ my $count = $aggregate->parsers;
+ my @parsers = $aggregate->parsers;
+ my @parsers = $aggregate->parsers(@descriptions);
+
+In scalar context without arguments, this method returns the number of parsers
+aggregated. In list context without arguments, returns the parsers in the
+order they were added.
+
+If C<@descriptions> is given, these correspond to the keys used in each
+call to the add() method. Returns an array of the requested parsers (in
+the requested order) in list context or an array reference in scalar
+context.
+
+Requesting an unknown identifier is a fatal error.
+
+=cut
+
+sub parsers {
+ my $self = shift;
+ return $self->_get_parsers(@_) if @_;
+ my $descriptions = $self->{parse_order};
+ my @parsers = @{ $self->{parser_for} }{@$descriptions};
+
+ # Note: Because of the way context works, we must assign the parsers to
+ # the @parsers array or else this method does not work as documented.
+ return @parsers;
+}
+
+sub _get_parsers {
+ my ( $self, @descriptions ) = @_;
+ my @parsers;
+ for my $description (@descriptions) {
+ $self->_croak("A parser for ($description) could not be found")
+ unless exists $self->{parser_for}{$description};
+ push @parsers => $self->{parser_for}{$description};
+ }
+ return wantarray ? @parsers : \@parsers;
+}
+
+=head3 C<descriptions>
+
+Get an array of descriptions in the order in which they were added to
+the aggregator.
+
+=cut
+
+sub descriptions { @{ shift->{parse_order} || [] } }
+
+=head3 C<start>
+
+Call C<start> immediately before adding any results to the aggregator.
+Among other times it records the start time for the test run.
+
+=cut
+
+sub start {
+ my $self = shift;
+ $self->{start_time} = Benchmark->new;
+}
+
+=head3 C<stop>
+
+Call C<stop> immediately after adding all test results to the aggregator.
+
+=cut
+
+sub stop {
+ my $self = shift;
+ $self->{end_time} = Benchmark->new;
+}
+
+=head3 C<elapsed>
+
+Elapsed returns a L<Benchmark> object that represents the running time
+of the aggregated tests. In order for C<elapsed> to be valid you must
+call C<start> before running the tests and C<stop> immediately
+afterwards.
+
+=cut
+
+sub elapsed {
+ my $self = shift;
+
+ require Carp;
+ Carp::croak
+ q{Can't call elapsed without first calling start and then stop}
+ unless defined $self->{start_time} && defined $self->{end_time};
+ return timediff( $self->{end_time}, $self->{start_time} );
+}
+
+=head3 C<elapsed_timestr>
+
+Returns a formatted string representing the runtime returned by
+C<elapsed()>. This lets the caller not worry about Benchmark.
+
+=cut
+
+sub elapsed_timestr {
+ my $self = shift;
+
+ my $elapsed = $self->elapsed;
+
+ return timestr($elapsed);
+}
+
+=head3 C<all_passed>
+
+Return true if all the tests passed and no parse errors were detected.
+
+=cut
+
+sub all_passed {
+ my $self = shift;
+ return
+ $self->total
+ && $self->total == $self->passed
+ && !$self->has_errors;
+}
+
+=head3 C<get_status>
+
+Get a single word describing the status of the aggregated tests.
+Depending on the outcome of the tests returns 'PASS', 'FAIL' or
+'NOTESTS'. This token is understood by L<CPAN::Reporter>.
+
+=cut
+
+sub get_status {
+ my $self = shift;
+
+ my $total = $self->total;
+ my $passed = $self->passed;
+
+ return
+ ( $self->has_errors || $total != $passed ) ? 'FAIL'
+ : $total ? 'PASS'
+ : 'NOTESTS';
+}
+
+##############################################################################
+
+=head2 Summary methods
+
+Each of the following methods will return the total number of corresponding
+tests if called in scalar context. If called in list context, returns the
+descriptions of the parsers which contain the corresponding tests (see C<add>
+for an explanation of description.
+
+=over 4
+
+=item * failed
+
+=item * parse_errors
+
+=item * passed
+
+=item * planned
+
+=item * skipped
+
+=item * todo
+
+=item * todo_passed
+
+=item * wait
+
+=item * exit
+
+=back
+
+For example, to find out how many tests unexpectedly succeeded (TODO tests
+which passed when they shouldn't):
+
+ my $count = $aggregate->todo_passed;
+ my @descriptions = $aggregate->todo_passed;
+
+Note that C<wait> and C<exit> are the totals of the wait and exit
+statuses of each of the tests. These values are totalled only to provide
+a true value if any of them are non-zero.
+
+=cut
+
+##############################################################################
+
+=head3 C<total>
+
+ my $tests_run = $aggregate->total;
+
+Returns the total number of tests run.
+
+=cut
+
+sub total { shift->{total} }
+
+##############################################################################
+
+=head3 C<has_problems>
+
+ if ( $parser->has_problems ) {
+ ...
+ }
+
+Identical to C<has_errors>, but also returns true if any TODO tests
+unexpectedly succeeded. This is more akin to "warnings".
+
+=cut
+
+sub has_problems {
+ my $self = shift;
+ return $self->todo_passed
+ || $self->has_errors;
+}
+
+##############################################################################
+
+=head3 C<has_errors>
+
+ if ( $parser->has_errors ) {
+ ...
+ }
+
+Returns true if I<any> of the parsers failed. This includes:
+
+=over 4
+
+=item * Failed tests
+
+=item * Parse errors
+
+=item * Bad exit or wait status
+
+=back
+
+=cut
+
+sub has_errors {
+ my $self = shift;
+ return
+ $self->failed
+ || $self->parse_errors
+ || $self->exit
+ || $self->wait;
+}
+
+##############################################################################
+
+=head3 C<todo_failed>
+
+ # deprecated in favor of 'todo_passed'. This method was horribly misnamed.
+
+This was a badly misnamed method. It indicates which TODO tests unexpectedly
+succeeded. Will now issue a warning and call C<todo_passed>.
+
+=cut
+
+sub todo_failed {
+ warn
+ '"todo_failed" is deprecated. Please use "todo_passed". See the docs.';
+ goto &todo_passed;
+}
+
+=head1 See Also
+
+L<TAP::Parser>
+
+L<TAP::Harness>
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Grammar.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Grammar.pm
new file mode 100755
index 0000000000..0258ad3206
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Grammar.pm
@@ -0,0 +1,590 @@
+package TAP::Parser::Grammar;
+
+use strict;
+use warnings;
+
+use TAP::Parser::ResultFactory ();
+use TAP::Parser::YAMLish::Reader ();
+
+use base 'TAP::Object';
+
+=head1 NAME
+
+TAP::Parser::Grammar - A grammar for the Test Anything Protocol.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Grammar;
+ my $grammar = $self->make_grammar({
+ iterator => $tap_parser_iterator,
+ parser => $tap_parser,
+ version => 12,
+ });
+
+ my $result = $grammar->tokenize;
+
+=head1 DESCRIPTION
+
+C<TAP::Parser::Grammar> tokenizes lines from a L<TAP::Parser::Iterator> and
+constructs L<TAP::Parser::Result> subclasses to represent the tokens.
+
+Do not attempt to use this class directly. It won't make sense. It's mainly
+here to ensure that we will be able to have pluggable grammars when TAP is
+expanded at some future date (plus, this stuff was really cluttering the
+parser).
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $grammar = TAP::Parser::Grammar->new({
+ iterator => $iterator,
+ parser => $parser,
+ version => $version,
+ });
+
+Returns L<TAP::Parser> grammar object that will parse the TAP stream from the
+specified iterator. Both C<iterator> and C<parser> are required arguments.
+If C<version> is not set it defaults to C<12> (see L</set_version> for more
+details).
+
+=cut
+
+# new() implementation supplied by TAP::Object
+sub _initialize {
+ my ( $self, $args ) = @_;
+ $self->{iterator} = $args->{iterator}; # TODO: accessor
+ $self->{iterator} ||= $args->{stream}; # deprecated
+ $self->{parser} = $args->{parser}; # TODO: accessor
+ $self->set_version( $args->{version} || 12 );
+ return $self;
+}
+
+my %language_for;
+
+{
+
+ # XXX the 'not' and 'ok' might be on separate lines in VMS ...
+ my $ok = qr/(?:not )?ok\b/;
+ my $num = qr/\d+/;
+
+ my %v12 = (
+ version => {
+ syntax => qr/^TAP\s+version\s+(\d+)\s*\z/i,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my $version = $1;
+ return $self->_make_version_token( $line, $version, );
+ },
+ },
+ plan => {
+ syntax => qr/^1\.\.(\d+)\s*(.*)\z/,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my ( $tests_planned, $tail ) = ( $1, $2 );
+ my $explanation = undef;
+ my $skip = '';
+
+ if ( $tail =~ /^todo((?:\s+\d+)+)/ ) {
+ my @todo = split /\s+/, _trim($1);
+ return $self->_make_plan_token(
+ $line, $tests_planned, 'TODO',
+ '', \@todo
+ );
+ }
+ elsif ( 0 == $tests_planned ) {
+ $skip = 'SKIP';
+
+ # If we can't match # SKIP the directive should be undef.
+ ($explanation) = $tail =~ /^#\s*SKIP\S*\s+(.*)/i;
+ }
+ elsif ( $tail !~ /^\s*$/ ) {
+ return $self->_make_unknown_token($line);
+ }
+
+ $explanation = '' unless defined $explanation;
+
+ return $self->_make_plan_token(
+ $line, $tests_planned, $skip,
+ $explanation, []
+ );
+
+ },
+ },
+
+ # An optimization to handle the most common test lines without
+ # directives.
+ simple_test => {
+ syntax => qr/^($ok) \ ($num) (?:\ ([^#]+))? \z/x,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my ( $ok, $num, $desc ) = ( $1, $2, $3 );
+
+ return $self->_make_test_token(
+ $line, $ok, $num,
+ $desc
+ );
+ },
+ },
+ test => {
+ syntax => qr/^($ok) \s* ($num)? \s* (.*) \z/x,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my ( $ok, $num, $desc ) = ( $1, $2, $3 );
+ my ( $dir, $explanation ) = ( '', '' );
+ if ($desc =~ m/^ ( [^\\\#]* (?: \\. [^\\\#]* )* )
+ \# \s* (SKIP|TODO) \b \s* (.*) $/ix
+ )
+ {
+ ( $desc, $dir, $explanation ) = ( $1, $2, $3 );
+ }
+ return $self->_make_test_token(
+ $line, $ok, $num, $desc,
+ $dir, $explanation
+ );
+ },
+ },
+ comment => {
+ syntax => qr/^#(.*)/,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my $comment = $1;
+ return $self->_make_comment_token( $line, $comment );
+ },
+ },
+ bailout => {
+ syntax => qr/^\s*Bail out!\s*(.*)/,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my $explanation = $1;
+ return $self->_make_bailout_token(
+ $line,
+ $explanation
+ );
+ },
+ },
+ );
+
+ my %v13 = (
+ %v12,
+ plan => {
+ syntax => qr/^1\.\.(\d+)\s*(?:\s*#\s*SKIP\b(.*))?\z/i,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my ( $tests_planned, $explanation ) = ( $1, $2 );
+ my $skip
+ = ( 0 == $tests_planned || defined $explanation )
+ ? 'SKIP'
+ : '';
+ $explanation = '' unless defined $explanation;
+ return $self->_make_plan_token(
+ $line, $tests_planned, $skip,
+ $explanation, []
+ );
+ },
+ },
+ yaml => {
+ syntax => qr/^ (\s+) (---.*) $/x,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my ( $pad, $marker ) = ( $1, $2 );
+ return $self->_make_yaml_token( $pad, $marker );
+ },
+ },
+ pragma => {
+ syntax =>
+ qr/^ pragma \s+ ( [-+] \w+ \s* (?: , \s* [-+] \w+ \s* )* ) $/x,
+ handler => sub {
+ my ( $self, $line ) = @_;
+ my $pragmas = $1;
+ return $self->_make_pragma_token( $line, $pragmas );
+ },
+ },
+ );
+
+ %language_for = (
+ '12' => {
+ tokens => \%v12,
+ },
+ '13' => {
+ tokens => \%v13,
+ setup => sub {
+ shift->{iterator}->handle_unicode;
+ },
+ },
+ '14' => {
+ tokens => \%v13,
+ setup => sub {
+ shift->{iterator}->handle_unicode;
+ },
+ },
+ );
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<set_version>
+
+ $grammar->set_version(13);
+
+Tell the grammar which TAP syntax version to support. The lowest
+supported version is 12. Although 'TAP version' isn't valid version 12
+syntax it is accepted so that higher version numbers may be parsed.
+
+=cut
+
+sub set_version {
+ my $self = shift;
+ my $version = shift;
+
+ if ( my $language = $language_for{$version} ) {
+ $self->{version} = $version;
+ $self->{tokens} = $language->{tokens};
+
+ if ( my $setup = $language->{setup} ) {
+ $self->$setup();
+ }
+
+ $self->_order_tokens;
+ }
+ else {
+ require Carp;
+ Carp::croak("Unsupported syntax version: $version");
+ }
+}
+
+# Optimization to put the most frequent tokens first.
+sub _order_tokens {
+ my $self = shift;
+
+ my %copy = %{ $self->{tokens} };
+ my @ordered_tokens = grep {defined}
+ map { delete $copy{$_} } qw( simple_test test comment plan );
+ push @ordered_tokens, values %copy;
+
+ $self->{ordered_tokens} = \@ordered_tokens;
+}
+
+##############################################################################
+
+=head3 C<tokenize>
+
+ my $token = $grammar->tokenize;
+
+This method will return a L<TAP::Parser::Result> object representing the
+current line of TAP.
+
+=cut
+
+sub tokenize {
+ my $self = shift;
+
+ my $line = $self->{iterator}->next;
+ unless ( defined $line ) {
+ delete $self->{parser}; # break circular ref
+ return;
+ }
+
+ my $token;
+
+ for my $token_data ( @{ $self->{ordered_tokens} } ) {
+ if ( $line =~ $token_data->{syntax} ) {
+ my $handler = $token_data->{handler};
+ $token = $self->$handler($line);
+ last;
+ }
+ }
+
+ $token = $self->_make_unknown_token($line) unless $token;
+
+ return $self->{parser}->make_result($token);
+}
+
+##############################################################################
+
+=head3 C<token_types>
+
+ my @types = $grammar->token_types;
+
+Returns the different types of tokens which this grammar can parse.
+
+=cut
+
+sub token_types {
+ my $self = shift;
+ return keys %{ $self->{tokens} };
+}
+
+##############################################################################
+
+=head3 C<syntax_for>
+
+ my $syntax = $grammar->syntax_for($token_type);
+
+Returns a pre-compiled regular expression which will match a chunk of TAP
+corresponding to the token type. For example (not that you should really pay
+attention to this, C<< $grammar->syntax_for('comment') >> will return
+C<< qr/^#(.*)/ >>.
+
+=cut
+
+sub syntax_for {
+ my ( $self, $type ) = @_;
+ return $self->{tokens}->{$type}->{syntax};
+}
+
+##############################################################################
+
+=head3 C<handler_for>
+
+ my $handler = $grammar->handler_for($token_type);
+
+Returns a code reference which, when passed an appropriate line of TAP,
+returns the lexed token corresponding to that line. As a result, the basic
+TAP parsing loop looks similar to the following:
+
+ my @tokens;
+ my $grammar = TAP::Grammar->new;
+ LINE: while ( defined( my $line = $parser->_next_chunk_of_tap ) ) {
+ for my $type ( $grammar->token_types ) {
+ my $syntax = $grammar->syntax_for($type);
+ if ( $line =~ $syntax ) {
+ my $handler = $grammar->handler_for($type);
+ push @tokens => $grammar->$handler($line);
+ next LINE;
+ }
+ }
+ push @tokens => $grammar->_make_unknown_token($line);
+ }
+
+=cut
+
+sub handler_for {
+ my ( $self, $type ) = @_;
+ return $self->{tokens}->{$type}->{handler};
+}
+
+sub _make_version_token {
+ my ( $self, $line, $version ) = @_;
+ return {
+ type => 'version',
+ raw => $line,
+ version => $version,
+ };
+}
+
+sub _make_plan_token {
+ my ( $self, $line, $tests_planned, $directive, $explanation, $todo ) = @_;
+
+ if ( $directive eq 'SKIP'
+ && 0 != $tests_planned
+ && $self->{version} < 13 )
+ {
+ warn
+ "Specified SKIP directive in plan but more than 0 tests ($line)\n";
+ }
+
+ return {
+ type => 'plan',
+ raw => $line,
+ tests_planned => $tests_planned,
+ directive => $directive,
+ explanation => _trim($explanation),
+ todo_list => $todo,
+ };
+}
+
+sub _make_test_token {
+ my ( $self, $line, $ok, $num, $desc, $dir, $explanation ) = @_;
+ return {
+ ok => $ok,
+
+ # forcing this to be an integer (and not a string) reduces memory
+ # consumption. RT #84939
+ test_num => ( defined $num ? 0 + $num : undef ),
+ description => _trim($desc),
+ directive => ( defined $dir ? uc $dir : '' ),
+ explanation => _trim($explanation),
+ raw => $line,
+ type => 'test',
+ };
+}
+
+sub _make_unknown_token {
+ my ( $self, $line ) = @_;
+ return {
+ raw => $line,
+ type => 'unknown',
+ };
+}
+
+sub _make_comment_token {
+ my ( $self, $line, $comment ) = @_;
+ return {
+ type => 'comment',
+ raw => $line,
+ comment => _trim($comment)
+ };
+}
+
+sub _make_bailout_token {
+ my ( $self, $line, $explanation ) = @_;
+ return {
+ type => 'bailout',
+ raw => $line,
+ bailout => _trim($explanation)
+ };
+}
+
+sub _make_yaml_token {
+ my ( $self, $pad, $marker ) = @_;
+
+ my $yaml = TAP::Parser::YAMLish::Reader->new;
+
+ my $iterator = $self->{iterator};
+
+ # Construct a reader that reads from our input stripping leading
+ # spaces from each line.
+ my $leader = length($pad);
+ my $strip = qr{ ^ (\s{$leader}) (.*) $ }x;
+ my @extra = ($marker);
+ my $reader = sub {
+ return shift @extra if @extra;
+ my $line = $iterator->next;
+ return $2 if $line =~ $strip;
+ return;
+ };
+
+ my $data = $yaml->read($reader);
+
+ # Reconstitute input. This is convoluted. Maybe we should just
+ # record it on the way in...
+ chomp( my $raw = $yaml->get_raw );
+ $raw =~ s/^/$pad/mg;
+
+ return {
+ type => 'yaml',
+ raw => $raw,
+ data => $data
+ };
+}
+
+sub _make_pragma_token {
+ my ( $self, $line, $pragmas ) = @_;
+ return {
+ type => 'pragma',
+ raw => $line,
+ pragmas => [ split /\s*,\s*/, _trim($pragmas) ],
+ };
+}
+
+sub _trim {
+ my $data = shift;
+
+ return '' unless defined $data;
+
+ $data =~ s/^\s+//;
+ $data =~ s/\s+$//;
+ return $data;
+}
+
+1;
+
+=head1 TAP GRAMMAR
+
+B<NOTE:> This grammar is slightly out of date. There's still some discussion
+about it and a new one will be provided when we have things better defined.
+
+The L<TAP::Parser> does not use a formal grammar because TAP is essentially a
+stream-based protocol. In fact, it's quite legal to have an infinite stream.
+For the same reason that we don't apply regexes to streams, we're not using a
+formal grammar here. Instead, we parse the TAP in lines.
+
+For purposes for forward compatibility, any result which does not match the
+following grammar is currently referred to as
+L<TAP::Parser::Result::Unknown>. It is I<not> a parse error.
+
+A formal grammar would look similar to the following:
+
+ (*
+ For the time being, I'm cheating on the EBNF by allowing
+ certain terms to be defined by POSIX character classes by
+ using the following syntax:
+
+ digit ::= [:digit:]
+
+ As far as I am aware, that's not valid EBNF. Sue me. I
+ didn't know how to write "char" otherwise (Unicode issues).
+ Suggestions welcome.
+ *)
+
+ tap ::= version? { comment | unknown } leading_plan lines
+ |
+ lines trailing_plan {comment}
+
+ version ::= 'TAP version ' positiveInteger {positiveInteger} "\n"
+
+ leading_plan ::= plan skip_directive? "\n"
+
+ trailing_plan ::= plan "\n"
+
+ plan ::= '1..' nonNegativeInteger
+
+ lines ::= line {line}
+
+ line ::= (comment | test | unknown | bailout ) "\n"
+
+ test ::= status positiveInteger? description? directive?
+
+ status ::= 'not '? 'ok '
+
+ description ::= (character - (digit | '#')) {character - '#'}
+
+ directive ::= todo_directive | skip_directive
+
+ todo_directive ::= hash_mark 'TODO' ' ' {character}
+
+ skip_directive ::= hash_mark 'SKIP' ' ' {character}
+
+ comment ::= hash_mark {character}
+
+ hash_mark ::= '#' {' '}
+
+ bailout ::= 'Bail out!' {character}
+
+ unknown ::= { (character - "\n") }
+
+ (* POSIX character classes and other terminals *)
+
+ digit ::= [:digit:]
+ character ::= ([:print:] - "\n")
+ positiveInteger ::= ( digit - '0' ) {digit}
+ nonNegativeInteger ::= digit {digit}
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+If you I<really> want to subclass L<TAP::Parser>'s grammar the best thing to
+do is read through the code. There's no easy way of summarizing it here.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Iterator>,
+L<TAP::Parser::Result>,
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator.pm
new file mode 100755
index 0000000000..a1d66c6ef4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator.pm
@@ -0,0 +1,162 @@
+package TAP::Parser::Iterator;
+
+use strict;
+use warnings;
+
+use base 'TAP::Object';
+
+=head1 NAME
+
+TAP::Parser::Iterator - Base class for TAP source iterators
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ # to subclass:
+ use TAP::Parser::Iterator ();
+ use base 'TAP::Parser::Iterator';
+ sub _initialize {
+ # see TAP::Object...
+ }
+
+ sub next_raw { ... }
+ sub wait { ... }
+ sub exit { ... }
+
+=head1 DESCRIPTION
+
+This is a simple iterator base class that defines L<TAP::Parser>'s iterator
+API. Iterators are typically created from L<TAP::Parser::SourceHandler>s.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Create an iterator. Provided by L<TAP::Object>.
+
+=head2 Instance Methods
+
+=head3 C<next>
+
+ while ( my $item = $iter->next ) { ... }
+
+Iterate through it, of course.
+
+=head3 C<next_raw>
+
+B<Note:> this method is abstract and should be overridden.
+
+ while ( my $item = $iter->next_raw ) { ... }
+
+Iterate raw input without applying any fixes for quirky input syntax.
+
+=cut
+
+sub next {
+ my $self = shift;
+ my $line = $self->next_raw;
+
+ # vms nit: When encountering 'not ok', vms often has the 'not' on a line
+ # by itself:
+ # not
+ # ok 1 - 'I hate VMS'
+ if ( defined($line) and $line =~ /^\s*not\s*$/ ) {
+ $line .= ( $self->next_raw || '' );
+ }
+
+ return $line;
+}
+
+sub next_raw {
+ require Carp;
+ my $msg = Carp::longmess('abstract method called directly!');
+ $_[0]->_croak($msg);
+}
+
+=head3 C<handle_unicode>
+
+If necessary switch the input stream to handle unicode. This only has
+any effect for I/O handle based streams.
+
+The default implementation does nothing.
+
+=cut
+
+sub handle_unicode { }
+
+=head3 C<get_select_handles>
+
+Return a list of filehandles that may be used upstream in a select()
+call to signal that this Iterator is ready. Iterators that are not
+handle-based should return an empty list.
+
+The default implementation does nothing.
+
+=cut
+
+sub get_select_handles {
+ return;
+}
+
+=head3 C<wait>
+
+B<Note:> this method is abstract and should be overridden.
+
+ my $wait_status = $iter->wait;
+
+Return the C<wait> status for this iterator.
+
+=head3 C<exit>
+
+B<Note:> this method is abstract and should be overridden.
+
+ my $wait_status = $iter->exit;
+
+Return the C<exit> status for this iterator.
+
+=cut
+
+sub wait {
+ require Carp;
+ my $msg = Carp::longmess('abstract method called directly!');
+ $_[0]->_croak($msg);
+}
+
+sub exit {
+ require Carp;
+ my $msg = Carp::longmess('abstract method called directly!');
+ $_[0]->_croak($msg);
+}
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+You must override the abstract methods as noted above.
+
+=head2 Example
+
+L<TAP::Parser::Iterator::Array> is probably the easiest example to follow.
+There's not much point repeating it here.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Iterator::Array>,
+L<TAP::Parser::Iterator::Stream>,
+L<TAP::Parser::Iterator::Process>,
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Array.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Array.pm
new file mode 100755
index 0000000000..ceb8198baf
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Array.pm
@@ -0,0 +1,100 @@
+package TAP::Parser::Iterator::Array;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Iterator';
+
+=head1 NAME
+
+TAP::Parser::Iterator::Array - Iterator for array-based TAP sources
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Iterator::Array;
+ my @data = ('foo', 'bar', baz');
+ my $it = TAP::Parser::Iterator::Array->new(\@data);
+ my $line = $it->next;
+
+=head1 DESCRIPTION
+
+This is a simple iterator wrapper for arrays of scalar content, used by
+L<TAP::Parser>. Unless you're writing a plugin or subclassing, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Create an iterator. Takes one argument: an C<$array_ref>
+
+=head2 Instance Methods
+
+=head3 C<next>
+
+Iterate through it, of course.
+
+=head3 C<next_raw>
+
+Iterate raw input without applying any fixes for quirky input syntax.
+
+=head3 C<wait>
+
+Get the wait status for this iterator. For an array iterator this will always
+be zero.
+
+=head3 C<exit>
+
+Get the exit status for this iterator. For an array iterator this will always
+be zero.
+
+=cut
+
+# new() implementation supplied by TAP::Object
+
+sub _initialize {
+ my ( $self, $thing ) = @_;
+ chomp @$thing;
+ $self->{idx} = 0;
+ $self->{array} = $thing;
+ $self->{exit} = undef;
+ return $self;
+}
+
+sub wait { shift->exit }
+
+sub exit {
+ my $self = shift;
+ return 0 if $self->{idx} >= @{ $self->{array} };
+ return;
+}
+
+sub next_raw {
+ my $self = shift;
+ return $self->{array}->[ $self->{idx}++ ];
+}
+
+1;
+
+=head1 ATTRIBUTION
+
+Originally ripped off from L<Test::Harness>.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Iterator>,
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Process.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Process.pm
new file mode 100755
index 0000000000..249ecde9a5
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Process.pm
@@ -0,0 +1,381 @@
+package TAP::Parser::Iterator::Process;
+
+use strict;
+use warnings;
+
+use Config;
+use IO::Handle;
+
+use base 'TAP::Parser::Iterator';
+
+my $IS_WIN32 = ( $^O =~ /^(MS)?Win32$/ );
+
+=head1 NAME
+
+TAP::Parser::Iterator::Process - Iterator for process-based TAP sources
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Iterator::Process;
+ my %args = (
+ command => ['python', 'setup.py', 'test'],
+ merge => 1,
+ setup => sub { ... },
+ teardown => sub { ... },
+ );
+ my $it = TAP::Parser::Iterator::Process->new(\%args);
+ my $line = $it->next;
+
+=head1 DESCRIPTION
+
+This is a simple iterator wrapper for executing external processes, used by
+L<TAP::Parser>. Unless you're writing a plugin or subclassing, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Create an iterator. Expects one argument containing a hashref of the form:
+
+ command => \@command_to_execute
+ merge => $attempt_merge_stderr_and_stdout?
+ setup => $callback_to_setup_command
+ teardown => $callback_to_teardown_command
+
+Tries to uses L<IPC::Open3> & L<IO::Select> to communicate with the spawned
+process if they are available. Falls back onto C<open()>.
+
+=head2 Instance Methods
+
+=head3 C<next>
+
+Iterate through the process output, of course.
+
+=head3 C<next_raw>
+
+Iterate raw input without applying any fixes for quirky input syntax.
+
+=head3 C<wait>
+
+Get the wait status for this iterator's process.
+
+=head3 C<exit>
+
+Get the exit status for this iterator's process.
+
+=cut
+
+{
+
+ no warnings 'uninitialized';
+ # get around a catch22 in the test suite that causes failures on Win32:
+ local $SIG{__DIE__} = undef;
+ eval { require POSIX; &POSIX::WEXITSTATUS(0) };
+ if ($@) {
+ *_wait2exit = sub { $_[1] >> 8 };
+ }
+ else {
+ *_wait2exit = sub { POSIX::WEXITSTATUS( $_[1] ) }
+ }
+}
+
+sub _use_open3 {
+ my $self = shift;
+ return unless $Config{d_fork} || $IS_WIN32;
+ for my $module (qw( IPC::Open3 IO::Select )) {
+ eval "use $module";
+ return if $@;
+ }
+ return 1;
+}
+
+{
+ my $got_unicode;
+
+ sub _get_unicode {
+ return $got_unicode if defined $got_unicode;
+ eval 'use Encode qw(decode_utf8);';
+ $got_unicode = $@ ? 0 : 1;
+
+ }
+}
+
+# new() implementation supplied by TAP::Object
+
+sub _initialize {
+ my ( $self, $args ) = @_;
+
+ my @command = @{ delete $args->{command} || [] }
+ or die "Must supply a command to execute";
+
+ $self->{command} = [@command];
+
+ # Private. Used to frig with chunk size during testing.
+ my $chunk_size = delete $args->{_chunk_size} || 65536;
+
+ my $merge = delete $args->{merge};
+ my ( $pid, $err, $sel );
+
+ if ( my $setup = delete $args->{setup} ) {
+ $setup->(@command);
+ }
+
+ my $out = IO::Handle->new;
+
+ if ( $self->_use_open3 ) {
+
+ # HOTPATCH {{{
+ my $xclose = \&IPC::Open3::xclose;
+ no warnings;
+ local *IPC::Open3::xclose = sub {
+ my $fh = shift;
+ no strict 'refs';
+ return if ( fileno($fh) == fileno(STDIN) );
+ $xclose->($fh);
+ };
+
+ # }}}
+
+ if ($IS_WIN32) {
+ $err = $merge ? '' : '>&STDERR';
+ eval {
+ $pid = open3(
+ '<&STDIN', $out, $merge ? '' : $err,
+ @command
+ );
+ };
+ die "Could not execute (@command): $@" if $@;
+ if ( $] >= 5.006 ) {
+ binmode($out, ":crlf");
+ }
+ }
+ else {
+ $err = $merge ? '' : IO::Handle->new;
+ eval { $pid = open3( '<&STDIN', $out, $err, @command ); };
+ die "Could not execute (@command): $@" if $@;
+ $sel = $merge ? undef : IO::Select->new( $out, $err );
+ }
+ }
+ else {
+ $err = '';
+ my $exec = shift @command;
+ $exec = qq{"$exec"} if $exec =~ /\s/ and -x $exec;
+ my $command
+ = join( ' ', $exec, map { $_ =~ /\s/ ? qq{"$_"} : $_ } @command );
+ open( $out, "$command|" )
+ or die "Could not execute ($command): $!";
+ }
+
+ $self->{out} = $out;
+ $self->{err} = $err;
+ $self->{sel} = $sel;
+ $self->{pid} = $pid;
+ $self->{exit} = undef;
+ $self->{chunk_size} = $chunk_size;
+
+ if ( my $teardown = delete $args->{teardown} ) {
+ $self->{teardown} = sub {
+ $teardown->(@command);
+ };
+ }
+
+ return $self;
+}
+
+=head3 C<handle_unicode>
+
+Upgrade the input stream to handle UTF8.
+
+=cut
+
+sub handle_unicode {
+ my $self = shift;
+
+ if ( $self->{sel} ) {
+ if ( _get_unicode() ) {
+
+ # Make sure our iterator has been constructed and...
+ my $next = $self->{_next} ||= $self->_next;
+
+ # ...wrap it to do UTF8 casting
+ $self->{_next} = sub {
+ my $line = $next->();
+ return decode_utf8($line) if defined $line;
+ return;
+ };
+ }
+ }
+ else {
+ if ( $] >= 5.008 ) {
+ eval 'binmode($self->{out}, ":utf8")';
+ }
+ }
+
+}
+
+##############################################################################
+
+sub wait { shift->{wait} }
+sub exit { shift->{exit} }
+
+sub _next {
+ my $self = shift;
+
+ if ( my $out = $self->{out} ) {
+ if ( my $sel = $self->{sel} ) {
+ my $err = $self->{err};
+ my @buf = ();
+ my $partial = ''; # Partial line
+ my $chunk_size = $self->{chunk_size};
+ return sub {
+ return shift @buf if @buf;
+
+ READ:
+ while ( my @ready = $sel->can_read ) {
+ for my $fh (@ready) {
+ my $got = sysread $fh, my ($chunk), $chunk_size;
+
+ if ( $got == 0 ) {
+ $sel->remove($fh);
+ }
+ elsif ( $fh == $err ) {
+ print STDERR $chunk; # echo STDERR
+ }
+ else {
+ $chunk = $partial . $chunk;
+ $partial = '';
+
+ # Make sure we have a complete line
+ unless ( substr( $chunk, -1, 1 ) eq "\n" ) {
+ my $nl = rindex $chunk, "\n";
+ if ( $nl == -1 ) {
+ $partial = $chunk;
+ redo READ;
+ }
+ else {
+ $partial = substr( $chunk, $nl + 1 );
+ $chunk = substr( $chunk, 0, $nl );
+ }
+ }
+
+ push @buf, split /\n/, $chunk;
+ return shift @buf if @buf;
+ }
+ }
+ }
+
+ # Return partial last line
+ if ( length $partial ) {
+ my $last = $partial;
+ $partial = '';
+ return $last;
+ }
+
+ $self->_finish;
+ return;
+ };
+ }
+ else {
+ return sub {
+ local $/ = "\n"; # to ensure lines
+ if ( defined( my $line = <$out> ) ) {
+ chomp $line;
+ return $line;
+ }
+ $self->_finish;
+ return;
+ };
+ }
+ }
+ else {
+ return sub {
+ $self->_finish;
+ return;
+ };
+ }
+}
+
+sub next_raw {
+ my $self = shift;
+ return ( $self->{_next} ||= $self->_next )->();
+}
+
+sub _finish {
+ my $self = shift;
+
+ my $status = $?;
+
+ # Avoid circular refs
+ $self->{_next} = sub {return}
+ if $] >= 5.006;
+
+ # If we have a subprocess we need to wait for it to terminate
+ if ( defined $self->{pid} ) {
+ if ( $self->{pid} == waitpid( $self->{pid}, 0 ) ) {
+ $status = $?;
+ }
+ }
+
+ ( delete $self->{out} )->close if $self->{out};
+
+ # If we have an IO::Select we also have an error handle to close.
+ if ( $self->{sel} ) {
+ ( delete $self->{err} )->close;
+ delete $self->{sel};
+ }
+ else {
+ $status = $?;
+ }
+
+ # Sometimes we get -1 on Windows. Presumably that means status not
+ # available.
+ $status = 0 if $IS_WIN32 && $status == -1;
+
+ $self->{wait} = $status;
+ $self->{exit} = $self->_wait2exit($status);
+
+ if ( my $teardown = $self->{teardown} ) {
+ $teardown->();
+ }
+
+ return $self;
+}
+
+=head3 C<get_select_handles>
+
+Return a list of filehandles that may be used upstream in a select()
+call to signal that this Iterator is ready. Iterators that are not
+handle based should return an empty list.
+
+=cut
+
+sub get_select_handles {
+ my $self = shift;
+ return grep $_, ( $self->{out}, $self->{err} );
+}
+
+1;
+
+=head1 ATTRIBUTION
+
+Originally ripped off from L<Test::Harness>.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Iterator>,
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Stream.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Stream.pm
new file mode 100755
index 0000000000..abee22906f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Iterator/Stream.pm
@@ -0,0 +1,116 @@
+package TAP::Parser::Iterator::Stream;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Iterator';
+
+=head1 NAME
+
+TAP::Parser::Iterator::Stream - Iterator for filehandle-based TAP sources
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Iterator::Stream;
+ open( TEST, 'test.tap' );
+ my $it = TAP::Parser::Iterator::Stream->new(\*TEST);
+ my $line = $it->next;
+
+=head1 DESCRIPTION
+
+This is a simple iterator wrapper for reading from filehandles, used by
+L<TAP::Parser>. Unless you're writing a plugin or subclassing, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Create an iterator. Expects one argument containing a filehandle.
+
+=cut
+
+# new() implementation supplied by TAP::Object
+
+sub _initialize {
+ my ( $self, $thing ) = @_;
+ $self->{fh} = $thing;
+ return $self;
+}
+
+=head2 Instance Methods
+
+=head3 C<next>
+
+Iterate through it, of course.
+
+=head3 C<next_raw>
+
+Iterate raw input without applying any fixes for quirky input syntax.
+
+=head3 C<wait>
+
+Get the wait status for this iterator. Always returns zero.
+
+=head3 C<exit>
+
+Get the exit status for this iterator. Always returns zero.
+
+=cut
+
+sub wait { shift->exit }
+sub exit { shift->{fh} ? () : 0 }
+
+sub next_raw {
+ my $self = shift;
+ my $fh = $self->{fh};
+
+ if ( defined( my $line = <$fh> ) ) {
+ chomp $line;
+ return $line;
+ }
+ else {
+ $self->_finish;
+ return;
+ }
+}
+
+sub _finish {
+ my $self = shift;
+ close delete $self->{fh};
+}
+
+sub get_select_handles {
+ my $self = shift;
+
+ # return our handle in case it's a socket or pipe (select()-able)
+ return ( $self->{fh}, )
+ if (-S $self->{fh} || -p $self->{fh});
+
+ return;
+}
+
+1;
+
+=head1 ATTRIBUTION
+
+Originally ripped off from L<Test::Harness>.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Iterator>,
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/IteratorFactory.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/IteratorFactory.pm
new file mode 100755
index 0000000000..4353f0aa96
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/IteratorFactory.pm
@@ -0,0 +1,339 @@
+package TAP::Parser::IteratorFactory;
+
+use strict;
+use warnings;
+
+use Carp qw( confess );
+use File::Basename qw( fileparse );
+
+use base 'TAP::Object';
+
+use constant handlers => [];
+
+=head1 NAME
+
+TAP::Parser::IteratorFactory - Figures out which SourceHandler objects to use for a given Source
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::IteratorFactory;
+ my $factory = TAP::Parser::IteratorFactory->new({ %config });
+ my $iterator = $factory->make_iterator( $filename );
+
+=head1 DESCRIPTION
+
+This is a factory class that takes a L<TAP::Parser::Source> and runs it through all the
+registered L<TAP::Parser::SourceHandler>s to see which one should handle the source.
+
+If you're a plugin author, you'll be interested in how to L</register_handler>s,
+how L</detect_source> works.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Creates a new factory class:
+
+ my $sf = TAP::Parser::IteratorFactory->new( $config );
+
+C<$config> is optional. If given, sets L</config> and calls L</load_handlers>.
+
+=cut
+
+sub _initialize {
+ my ( $self, $config ) = @_;
+ $self->config( $config || {} )->load_handlers;
+ return $self;
+}
+
+=head3 C<register_handler>
+
+Registers a new L<TAP::Parser::SourceHandler> with this factory.
+
+ __PACKAGE__->register_handler( $handler_class );
+
+=head3 C<handlers>
+
+List of handlers that have been registered.
+
+=cut
+
+sub register_handler {
+ my ( $class, $dclass ) = @_;
+
+ confess("$dclass must implement can_handle & make_iterator methods!")
+ unless UNIVERSAL::can( $dclass, 'can_handle' )
+ && UNIVERSAL::can( $dclass, 'make_iterator' );
+
+ my $handlers = $class->handlers;
+ push @{$handlers}, $dclass
+ unless grep { $_ eq $dclass } @{$handlers};
+
+ return $class;
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<config>
+
+ my $cfg = $sf->config;
+ $sf->config({ Perl => { %config } });
+
+Chaining getter/setter for the configuration of the available source handlers.
+This is a hashref keyed on handler class whose values contain config to be passed
+onto the handlers during detection & creation. Class names may be fully qualified
+or abbreviated, eg:
+
+ # these are equivalent
+ $sf->config({ 'TAP::Parser::SourceHandler::Perl' => { %config } });
+ $sf->config({ 'Perl' => { %config } });
+
+=cut
+
+sub config {
+ my $self = shift;
+ return $self->{config} unless @_;
+ unless ( 'HASH' eq ref $_[0] ) {
+ $self->_croak('Argument to &config must be a hash reference');
+ }
+ $self->{config} = shift;
+ return $self;
+}
+
+sub _last_handler {
+ my $self = shift;
+ return $self->{last_handler} unless @_;
+ $self->{last_handler} = shift;
+ return $self;
+}
+
+sub _testing {
+ my $self = shift;
+ return $self->{testing} unless @_;
+ $self->{testing} = shift;
+ return $self;
+}
+
+##############################################################################
+
+=head3 C<load_handlers>
+
+ $sf->load_handlers;
+
+Loads the handler classes defined in L</config>. For example, given a config:
+
+ $sf->config({
+ MySourceHandler => { some => 'config' },
+ });
+
+C<load_handlers> will attempt to load the C<MySourceHandler> class by looking in
+C<@INC> for it in this order:
+
+ TAP::Parser::SourceHandler::MySourceHandler
+ MySourceHandler
+
+C<croak>s on error.
+
+=cut
+
+sub load_handlers {
+ my ($self) = @_;
+ for my $handler ( keys %{ $self->config } ) {
+ my $sclass = $self->_load_handler($handler);
+
+ # TODO: store which class we loaded anywhere?
+ }
+ return $self;
+}
+
+sub _load_handler {
+ my ( $self, $handler ) = @_;
+
+ my @errors;
+ for my $dclass ( "TAP::Parser::SourceHandler::$handler", $handler ) {
+ return $dclass
+ if UNIVERSAL::can( $dclass, 'can_handle' )
+ && UNIVERSAL::can( $dclass, 'make_iterator' );
+
+ eval "use $dclass";
+ if ( my $e = $@ ) {
+ push @errors, $e;
+ next;
+ }
+
+ return $dclass
+ if UNIVERSAL::can( $dclass, 'can_handle' )
+ && UNIVERSAL::can( $dclass, 'make_iterator' );
+ push @errors,
+ "handler '$dclass' does not implement can_handle & make_iterator";
+ }
+
+ $self->_croak(
+ "Cannot load handler '$handler': " . join( "\n", @errors ) );
+}
+
+##############################################################################
+
+=head3 C<make_iterator>
+
+ my $iterator = $src_factory->make_iterator( $source );
+
+Given a L<TAP::Parser::Source>, finds the most suitable L<TAP::Parser::SourceHandler>
+to use to create a L<TAP::Parser::Iterator> (see L</detect_source>). Dies on error.
+
+=cut
+
+sub make_iterator {
+ my ( $self, $source ) = @_;
+
+ $self->_croak('no raw source defined!') unless defined $source->raw;
+
+ $source->config( $self->config )->assemble_meta;
+
+ # is the raw source already an object?
+ return $source->raw
+ if ( $source->meta->{is_object}
+ && UNIVERSAL::isa( $source->raw, 'TAP::Parser::SourceHandler' ) );
+
+ # figure out what kind of source it is
+ my $sd_class = $self->detect_source($source);
+ $self->_last_handler($sd_class);
+
+ return if $self->_testing;
+
+ # create it
+ my $iterator = $sd_class->make_iterator($source);
+
+ return $iterator;
+}
+
+=head3 C<detect_source>
+
+Given a L<TAP::Parser::Source>, detects what kind of source it is and
+returns I<one> L<TAP::Parser::SourceHandler> (the most confident one). Dies
+on error.
+
+The detection algorithm works something like this:
+
+ for (@registered_handlers) {
+ # ask them how confident they are about handling this source
+ $confidence{$handler} = $handler->can_handle( $source )
+ }
+ # choose the most confident handler
+
+Ties are handled by choosing the first handler.
+
+=cut
+
+sub detect_source {
+ my ( $self, $source ) = @_;
+
+ confess('no raw source ref defined!') unless defined $source->raw;
+
+ # find a list of handlers that can handle this source:
+ my %confidence_for;
+ for my $handler ( @{ $self->handlers } ) {
+ my $confidence = $handler->can_handle($source);
+ # warn "handler: $handler: $confidence\n";
+ $confidence_for{$handler} = $confidence if $confidence;
+ }
+
+ if ( !%confidence_for ) {
+ # error: can't detect source
+ my $raw_source_short = substr( ${ $source->raw }, 0, 50 );
+ confess("Cannot detect source of '$raw_source_short'!");
+ return;
+ }
+
+ # if multiple handlers can handle it, choose the most confident one
+ my @handlers =
+ sort { $confidence_for{$b} <=> $confidence_for{$a} }
+ keys %confidence_for;
+
+ # Check for a tie.
+ if( @handlers > 1 &&
+ $confidence_for{$handlers[0]} == $confidence_for{$handlers[1]}
+ ) {
+ my $filename = $source->meta->{file}{basename};
+ die("There is a tie between $handlers[0] and $handlers[1].\n".
+ "Both voted $confidence_for{$handlers[0]} on $filename.\n");
+ }
+
+ # this is really useful for debugging handlers:
+ if ( $ENV{TAP_HARNESS_SOURCE_FACTORY_VOTES} ) {
+ warn(
+ "votes: ",
+ join( ', ', map {"$_: $confidence_for{$_}"} @handlers ),
+ "\n"
+ );
+ }
+
+ # return 1st
+ return $handlers[0];
+}
+
+1;
+
+__END__
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head2 Example
+
+If we've done things right, you'll probably want to write a new source,
+rather than sub-classing this (see L<TAP::Parser::SourceHandler> for that).
+
+But in case you find the need to...
+
+ package MyIteratorFactory;
+
+ use strict;
+
+ use base 'TAP::Parser::IteratorFactory';
+
+ # override source detection algorithm
+ sub detect_source {
+ my ($self, $raw_source_ref, $meta) = @_;
+ # do detective work, using $meta and whatever else...
+ }
+
+ 1;
+
+=head1 AUTHORS
+
+Steve Purkis
+
+=head1 ATTRIBUTION
+
+Originally ripped off from L<Test::Harness>.
+
+Moved out of L<TAP::Parser> & converted to a factory class to support
+extensible TAP source detective work by Steve Purkis.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::RawTAP>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::Executable>
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Multiplexer.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Multiplexer.pm
new file mode 100755
index 0000000000..aa3e864d79
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Multiplexer.pm
@@ -0,0 +1,196 @@
+package TAP::Parser::Multiplexer;
+
+use strict;
+use warnings;
+
+use IO::Select;
+use Errno;
+
+use base 'TAP::Object';
+
+use constant IS_WIN32 => $^O =~ /^(MS)?Win32$/;
+use constant IS_VMS => $^O eq 'VMS';
+use constant SELECT_OK => !( IS_VMS || IS_WIN32 );
+
+=head1 NAME
+
+TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Multiplexer;
+
+ my $mux = TAP::Parser::Multiplexer->new;
+ $mux->add( $parser1, $stash1 );
+ $mux->add( $parser2, $stash2 );
+ while ( my ( $parser, $stash, $result ) = $mux->next ) {
+ # do stuff
+ }
+
+=head1 DESCRIPTION
+
+C<TAP::Parser::Multiplexer> gathers input from multiple TAP::Parsers.
+Internally it calls select on the input file handles for those parsers
+to wait for one or more of them to have input available.
+
+See L<TAP::Harness> for an example of its use.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $mux = TAP::Parser::Multiplexer->new;
+
+Returns a new C<TAP::Parser::Multiplexer> object.
+
+=cut
+
+# new() implementation supplied by TAP::Object
+
+sub _initialize {
+ my $self = shift;
+ $self->{select} = IO::Select->new;
+ $self->{avid} = []; # Parsers that can't select
+ $self->{count} = 0;
+ return $self;
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<add>
+
+ $mux->add( $parser, $stash );
+
+Add a TAP::Parser to the multiplexer. C<$stash> is an optional opaque
+reference that will be returned from C<next> along with the parser and
+the next result.
+
+=cut
+
+sub add {
+ my ( $self, $parser, $stash ) = @_;
+
+ if ( SELECT_OK && ( my @handles = $parser->get_select_handles ) ) {
+ my $sel = $self->{select};
+
+ # We have to turn handles into file numbers here because by
+ # the time we want to remove them from our IO::Select they
+ # will already have been closed by the iterator.
+ my @filenos = map { fileno $_ } @handles;
+ for my $h (@handles) {
+ $sel->add( [ $h, $parser, $stash, @filenos ] );
+ }
+
+ $self->{count}++;
+ }
+ else {
+ push @{ $self->{avid} }, [ $parser, $stash ];
+ }
+}
+
+=head3 C<parsers>
+
+ my $count = $mux->parsers;
+
+Returns the number of parsers. Parsers are removed from the multiplexer
+when their input is exhausted.
+
+=cut
+
+sub parsers {
+ my $self = shift;
+ return $self->{count} + scalar @{ $self->{avid} };
+}
+
+sub _iter {
+ my $self = shift;
+
+ my $sel = $self->{select};
+ my $avid = $self->{avid};
+ my @ready = ();
+
+ return sub {
+
+ # Drain all the non-selectable parsers first
+ if (@$avid) {
+ my ( $parser, $stash ) = @{ $avid->[0] };
+ my $result = $parser->next;
+ shift @$avid unless defined $result;
+ return ( $parser, $stash, $result );
+ }
+
+ until (@ready) {
+ return unless $sel->count;
+ @ready = $sel->can_read;
+ last if @ready || !$!{EINTR};
+ }
+
+ my ( $h, $parser, $stash, @handles ) = @{ shift @ready };
+ my $result = $parser->next;
+
+ unless ( defined $result ) {
+ $sel->remove(@handles);
+ $self->{count}--;
+
+ # Force another can_read - we may now have removed a handle
+ # thought to have been ready.
+ @ready = ();
+ }
+
+ return ( $parser, $stash, $result );
+ };
+}
+
+=head3 C<next>
+
+Return a result from the next available parser. Returns a list
+containing the parser from which the result came, the stash that
+corresponds with that parser and the result.
+
+ my ( $parser, $stash, $result ) = $mux->next;
+
+If C<$result> is undefined the corresponding parser has reached the end
+of its input (and will automatically be removed from the multiplexer).
+
+When all parsers are exhausted an empty list will be returned.
+
+ if ( my ( $parser, $stash, $result ) = $mux->next ) {
+ if ( ! defined $result ) {
+ # End of this parser
+ }
+ else {
+ # Process result
+ }
+ }
+ else {
+ # All parsers finished
+ }
+
+=cut
+
+sub next {
+ my $self = shift;
+ return ( $self->{_iter} ||= $self->_iter )->();
+}
+
+=head1 See Also
+
+L<TAP::Parser>
+
+L<TAP::Harness>
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result.pm
new file mode 100755
index 0000000000..4083a29d09
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result.pm
@@ -0,0 +1,297 @@
+package TAP::Parser::Result;
+
+use strict;
+use warnings;
+
+use base 'TAP::Object';
+
+BEGIN {
+
+ # make is_* methods
+ my @attrs = qw( plan pragma test comment bailout version unknown yaml );
+ no strict 'refs';
+ for my $token (@attrs) {
+ my $method = "is_$token";
+ *$method = sub { return $token eq shift->type };
+ }
+}
+
+##############################################################################
+
+=head1 NAME
+
+TAP::Parser::Result - Base class for TAP::Parser output objects
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ # abstract class - not meant to be used directly
+ # see TAP::Parser::ResultFactory for preferred usage
+
+ # directly:
+ use TAP::Parser::Result;
+ my $token = {...};
+ my $result = TAP::Parser::Result->new( $token );
+
+=head2 DESCRIPTION
+
+This is a simple base class used by L<TAP::Parser> to store objects that
+represent the current bit of test output data from TAP (usually a single
+line). Unless you're subclassing, you probably won't need to use this module
+directly.
+
+=head2 METHODS
+
+=head3 C<new>
+
+ # see TAP::Parser::ResultFactory for preferred usage
+
+ # to use directly:
+ my $result = TAP::Parser::Result->new($token);
+
+Returns an instance the appropriate class for the test token passed in.
+
+=cut
+
+# new() implementation provided by TAP::Object
+
+sub _initialize {
+ my ( $self, $token ) = @_;
+ if ($token) {
+
+ # assign to a hash slice to make a shallow copy of the token.
+ # I guess we could assign to the hash as (by default) there are not
+ # contents, but that seems less helpful if someone wants to subclass us
+ @{$self}{ keys %$token } = values %$token;
+ }
+ return $self;
+}
+
+##############################################################################
+
+=head2 Boolean methods
+
+The following methods all return a boolean value and are to be overridden in
+the appropriate subclass.
+
+=over 4
+
+=item * C<is_plan>
+
+Indicates whether or not this is the test plan line.
+
+ 1..3
+
+=item * C<is_pragma>
+
+Indicates whether or not this is a pragma line.
+
+ pragma +strict
+
+=item * C<is_test>
+
+Indicates whether or not this is a test line.
+
+ ok 1 Is OK!
+
+=item * C<is_comment>
+
+Indicates whether or not this is a comment.
+
+ # this is a comment
+
+=item * C<is_bailout>
+
+Indicates whether or not this is bailout line.
+
+ Bail out! We're out of dilithium crystals.
+
+=item * C<is_version>
+
+Indicates whether or not this is a TAP version line.
+
+ TAP version 4
+
+=item * C<is_unknown>
+
+Indicates whether or not the current line could be parsed.
+
+ ... this line is junk ...
+
+=item * C<is_yaml>
+
+Indicates whether or not this is a YAML chunk.
+
+=back
+
+=cut
+
+##############################################################################
+
+=head3 C<raw>
+
+ print $result->raw;
+
+Returns the original line of text which was parsed.
+
+=cut
+
+sub raw { shift->{raw} }
+
+##############################################################################
+
+=head3 C<type>
+
+ my $type = $result->type;
+
+Returns the "type" of a token, such as C<comment> or C<test>.
+
+=cut
+
+sub type { shift->{type} }
+
+##############################################################################
+
+=head3 C<as_string>
+
+ print $result->as_string;
+
+Prints a string representation of the token. This might not be the exact
+output, however. Tests will have test numbers added if not present, TODO and
+SKIP directives will be capitalized and, in general, things will be cleaned
+up. If you need the original text for the token, see the C<raw> method.
+
+=cut
+
+sub as_string { shift->{raw} }
+
+##############################################################################
+
+=head3 C<is_ok>
+
+ if ( $result->is_ok ) { ... }
+
+Reports whether or not a given result has passed. Anything which is B<not> a
+test result returns true. This is merely provided as a convenient shortcut.
+
+=cut
+
+sub is_ok {1}
+
+##############################################################################
+
+=head3 C<passed>
+
+Deprecated. Please use C<is_ok> instead.
+
+=cut
+
+sub passed {
+ warn 'passed() is deprecated. Please use "is_ok()"';
+ shift->is_ok;
+}
+
+##############################################################################
+
+=head3 C<has_directive>
+
+ if ( $result->has_directive ) {
+ ...
+ }
+
+Indicates whether or not the given result has a TODO or SKIP directive.
+
+=cut
+
+sub has_directive {
+ my $self = shift;
+ return ( $self->has_todo || $self->has_skip );
+}
+
+##############################################################################
+
+=head3 C<has_todo>
+
+ if ( $result->has_todo ) {
+ ...
+ }
+
+Indicates whether or not the given result has a TODO directive.
+
+=cut
+
+sub has_todo { 'TODO' eq ( shift->{directive} || '' ) }
+
+##############################################################################
+
+=head3 C<has_skip>
+
+ if ( $result->has_skip ) {
+ ...
+ }
+
+Indicates whether or not the given result has a SKIP directive.
+
+=cut
+
+sub has_skip { 'SKIP' eq ( shift->{directive} || '' ) }
+
+=head3 C<set_directive>
+
+Set the directive associated with this token. Used internally to fake
+TODO tests.
+
+=cut
+
+sub set_directive {
+ my ( $self, $dir ) = @_;
+ $self->{directive} = $dir;
+}
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+Remember: if you want your subclass to be automatically used by the parser,
+you'll have to register it with L<TAP::Parser::ResultFactory/register_type>.
+
+If you're creating a completely new result I<type>, you'll probably need to
+subclass L<TAP::Parser::Grammar> too, or else it'll never get used.
+
+=head2 Example
+
+ package MyResult;
+
+ use strict;
+
+ use base 'TAP::Parser::Result';
+
+ # register with the factory:
+ TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
+
+ sub as_string { 'My results all look the same' }
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::ResultFactory>,
+L<TAP::Parser::Result::Bailout>,
+L<TAP::Parser::Result::Comment>,
+L<TAP::Parser::Result::Plan>,
+L<TAP::Parser::Result::Pragma>,
+L<TAP::Parser::Result::Test>,
+L<TAP::Parser::Result::Unknown>,
+L<TAP::Parser::Result::Version>,
+L<TAP::Parser::Result::YAML>,
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Bailout.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Bailout.pm
new file mode 100755
index 0000000000..9f676e629a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Bailout.pm
@@ -0,0 +1,62 @@
+package TAP::Parser::Result::Bailout;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Bailout - Bailout result token.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>. A token of this class will be
+returned if a bail out line is encountered.
+
+ 1..5
+ ok 1 - woo hooo!
+ Bail out! Well, so much for "woo hooo!"
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+=back
+
+=cut
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<explanation>
+
+ if ( $result->is_bailout ) {
+ my $explanation = $result->explanation;
+ print "We bailed out because ($explanation)";
+ }
+
+If, and only if, a token is a bailout token, you can get an "explanation" via
+this method. The explanation is the text after the mystical "Bail out!" words
+which appear in the tap output.
+
+=cut
+
+sub explanation { shift->{bailout} }
+sub as_string { shift->{bailout} }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Comment.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Comment.pm
new file mode 100755
index 0000000000..7e1a81ed7f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Comment.pm
@@ -0,0 +1,60 @@
+package TAP::Parser::Result::Comment;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Comment - Comment result token.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>. A token of this class will be
+returned if a comment line is encountered.
+
+ 1..1
+ ok 1 - woo hooo!
+ # this is a comment
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+Note that this method merely returns the comment preceded by a '# '.
+
+=back
+
+=cut
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<comment>
+
+ if ( $result->is_comment ) {
+ my $comment = $result->comment;
+ print "I have something to say: $comment";
+ }
+
+=cut
+
+sub comment { shift->{comment} }
+sub as_string { shift->{raw} }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Plan.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Plan.pm
new file mode 100755
index 0000000000..b8ae566d66
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Plan.pm
@@ -0,0 +1,119 @@
+package TAP::Parser::Result::Plan;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Plan - Plan result token.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>. A token of this class will be
+returned if a plan line is encountered.
+
+ 1..1
+ ok 1 - woo hooo!
+
+C<1..1> is the plan. Gotta have a plan.
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+=item * C<raw>
+
+=back
+
+=cut
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<plan>
+
+ if ( $result->is_plan ) {
+ print $result->plan;
+ }
+
+This is merely a synonym for C<as_string>.
+
+=cut
+
+sub plan { '1..' . shift->{tests_planned} }
+
+##############################################################################
+
+=head3 C<tests_planned>
+
+ my $planned = $result->tests_planned;
+
+Returns the number of tests planned. For example, a plan of C<1..17> will
+cause this method to return '17'.
+
+=cut
+
+sub tests_planned { shift->{tests_planned} }
+
+##############################################################################
+
+=head3 C<directive>
+
+ my $directive = $plan->directive;
+
+If a SKIP directive is included with the plan, this method will return it.
+
+ 1..0 # SKIP: why bother?
+
+=cut
+
+sub directive { shift->{directive} }
+
+##############################################################################
+
+=head3 C<has_skip>
+
+ if ( $result->has_skip ) { ... }
+
+Returns a boolean value indicating whether or not this test has a SKIP
+directive.
+
+=head3 C<explanation>
+
+ my $explanation = $plan->explanation;
+
+If a SKIP directive was included with the plan, this method will return the
+explanation, if any.
+
+=cut
+
+sub explanation { shift->{explanation} }
+
+=head3 C<todo_list>
+
+ my $todo = $result->todo_list;
+ for ( @$todo ) {
+ ...
+ }
+
+=cut
+
+sub todo_list { shift->{todo_list} }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Pragma.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Pragma.pm
new file mode 100755
index 0000000000..debc8a7626
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Pragma.pm
@@ -0,0 +1,62 @@
+package TAP::Parser::Result::Pragma;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Pragma - TAP pragma token.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>. A token of this class will be
+returned if a pragma is encountered.
+
+ TAP version 13
+ pragma +strict, -foo
+
+Pragmas are only supported from TAP version 13 onwards.
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+=item * C<raw>
+
+=back
+
+=cut
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<pragmas>
+
+if ( $result->is_pragma ) {
+ @pragmas = $result->pragmas;
+}
+
+=cut
+
+sub pragmas {
+ my @pragmas = @{ shift->{pragmas} };
+ return wantarray ? @pragmas : \@pragmas;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Test.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Test.pm
new file mode 100755
index 0000000000..5e5ea395a2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Test.pm
@@ -0,0 +1,271 @@
+package TAP::Parser::Result::Test;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Test - Test result token.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>. A token of this class will be
+returned if a test line is encountered.
+
+ 1..1
+ ok 1 - woo hooo!
+
+=head1 OVERRIDDEN METHODS
+
+This class is the workhorse of the L<TAP::Parser> system. Most TAP lines will
+be test lines and if C<< $result->is_test >>, then you have a bunch of methods
+at your disposal.
+
+=head2 Instance Methods
+
+=cut
+
+##############################################################################
+
+=head3 C<ok>
+
+ my $ok = $result->ok;
+
+Returns the literal text of the C<ok> or C<not ok> status.
+
+=cut
+
+sub ok { shift->{ok} }
+
+##############################################################################
+
+=head3 C<number>
+
+ my $test_number = $result->number;
+
+Returns the number of the test, even if the original TAP output did not supply
+that number.
+
+=cut
+
+sub number { shift->{test_num} }
+
+sub _number {
+ my ( $self, $number ) = @_;
+ $self->{test_num} = $number;
+}
+
+##############################################################################
+
+=head3 C<description>
+
+ my $description = $result->description;
+
+Returns the description of the test, if any. This is the portion after the
+test number but before the directive.
+
+=cut
+
+sub description { shift->{description} }
+
+##############################################################################
+
+=head3 C<directive>
+
+ my $directive = $result->directive;
+
+Returns either C<TODO> or C<SKIP> if either directive was present for a test
+line.
+
+=cut
+
+sub directive { shift->{directive} }
+
+##############################################################################
+
+=head3 C<explanation>
+
+ my $explanation = $result->explanation;
+
+If a test had either a C<TODO> or C<SKIP> directive, this method will return
+the accompanying explanation, if present.
+
+ not ok 17 - 'Pigs can fly' # TODO not enough acid
+
+For the above line, the explanation is I<not enough acid>.
+
+=cut
+
+sub explanation { shift->{explanation} }
+
+##############################################################################
+
+=head3 C<is_ok>
+
+ if ( $result->is_ok ) { ... }
+
+Returns a boolean value indicating whether or not the test passed. Remember
+that for TODO tests, the test always passes.
+
+If the test is unplanned, this method will always return false. See
+C<is_unplanned>.
+
+=cut
+
+sub is_ok {
+ my $self = shift;
+
+ return if $self->is_unplanned;
+
+ # TODO directives reverse the sense of a test.
+ return $self->has_todo ? 1 : $self->ok !~ /not/;
+}
+
+##############################################################################
+
+=head3 C<is_actual_ok>
+
+ if ( $result->is_actual_ok ) { ... }
+
+Returns a boolean value indicating whether or not the test passed, regardless
+of its TODO status.
+
+=cut
+
+sub is_actual_ok {
+ my $self = shift;
+ return $self->{ok} !~ /not/;
+}
+
+##############################################################################
+
+=head3 C<actual_passed>
+
+Deprecated. Please use C<is_actual_ok> instead.
+
+=cut
+
+sub actual_passed {
+ warn 'actual_passed() is deprecated. Please use "is_actual_ok()"';
+ goto &is_actual_ok;
+}
+
+##############################################################################
+
+=head3 C<todo_passed>
+
+ if ( $test->todo_passed ) {
+ # test unexpectedly succeeded
+ }
+
+If this is a TODO test and an 'ok' line, this method returns true.
+Otherwise, it will always return false (regardless of passing status on
+non-todo tests).
+
+This is used to track which tests unexpectedly succeeded.
+
+=cut
+
+sub todo_passed {
+ my $self = shift;
+ return $self->has_todo && $self->is_actual_ok;
+}
+
+##############################################################################
+
+=head3 C<todo_failed>
+
+ # deprecated in favor of 'todo_passed'. This method was horribly misnamed.
+
+This was a badly misnamed method. It indicates which TODO tests unexpectedly
+succeeded. Will now issue a warning and call C<todo_passed>.
+
+=cut
+
+sub todo_failed {
+ warn 'todo_failed() is deprecated. Please use "todo_passed()"';
+ goto &todo_passed;
+}
+
+##############################################################################
+
+=head3 C<has_skip>
+
+ if ( $result->has_skip ) { ... }
+
+Returns a boolean value indicating whether or not this test has a SKIP
+directive.
+
+=head3 C<has_todo>
+
+ if ( $result->has_todo ) { ... }
+
+Returns a boolean value indicating whether or not this test has a TODO
+directive.
+
+=head3 C<as_string>
+
+ print $result->as_string;
+
+This method prints the test as a string. It will probably be similar, but
+not necessarily identical, to the original test line. Directives are
+capitalized, some whitespace may be trimmed and a test number will be added if
+it was not present in the original line. If you need the original text of the
+test line, use the C<raw> method.
+
+=cut
+
+sub as_string {
+ my $self = shift;
+ my $string = $self->ok . " " . $self->number;
+ if ( my $description = $self->description ) {
+ $string .= " $description";
+ }
+ if ( my $directive = $self->directive ) {
+ my $explanation = $self->explanation;
+ $string .= " # $directive $explanation";
+ }
+ return $string;
+}
+
+##############################################################################
+
+=head3 C<is_unplanned>
+
+ if ( $test->is_unplanned ) { ... }
+ $test->is_unplanned(1);
+
+If a test number is greater than the number of planned tests, this method will
+return true. Unplanned tests will I<always> return false for C<is_ok>,
+regardless of whether or not the test C<has_todo>.
+
+Note that if tests have a trailing plan, it is not possible to set this
+property for unplanned tests as we do not know it's unplanned until the plan
+is reached:
+
+ print <<'END';
+ ok 1
+ ok 2
+ 1..1
+ END
+
+=cut
+
+sub is_unplanned {
+ my $self = shift;
+ return ( $self->{unplanned} || '' ) unless @_;
+ $self->{unplanned} = !!shift;
+ return $self;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Unknown.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Unknown.pm
new file mode 100755
index 0000000000..c46e8d9566
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Unknown.pm
@@ -0,0 +1,48 @@
+package TAP::Parser::Result::Unknown;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Unknown - Unknown result token.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>. A token of this class will be
+returned if the parser does not recognize the token line. For example:
+
+ 1..5
+ VERSION 7
+ ok 1 - woo hooo!
+ ... woo hooo! is cool!
+
+In the above "TAP", the second and fourth lines will generate "Unknown"
+tokens.
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+=item * C<raw>
+
+=back
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Version.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Version.pm
new file mode 100755
index 0000000000..497c10d567
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/Version.pm
@@ -0,0 +1,62 @@
+package TAP::Parser::Result::Version;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::Version - TAP syntax version token.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>. A token of this class will be
+returned if a version line is encountered.
+
+ TAP version 13
+ ok 1
+ not ok 2
+
+The first version of TAP to include an explicit version number is 13.
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+=item * C<raw>
+
+=back
+
+=cut
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<version>
+
+ if ( $result->is_version ) {
+ print $result->version;
+ }
+
+This is merely a synonym for C<as_string>.
+
+=cut
+
+sub version { shift->{version} }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/YAML.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/YAML.pm
new file mode 100755
index 0000000000..e6ca7466e9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Result/YAML.pm
@@ -0,0 +1,61 @@
+package TAP::Parser::Result::YAML;
+
+use strict;
+use warnings;
+
+use base 'TAP::Parser::Result';
+
+=head1 NAME
+
+TAP::Parser::Result::YAML - YAML result token.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 DESCRIPTION
+
+This is a subclass of L<TAP::Parser::Result>. A token of this class will be
+returned if a YAML block is encountered.
+
+ 1..1
+ ok 1 - woo hooo!
+
+C<1..1> is the plan. Gotta have a plan.
+
+=head1 OVERRIDDEN METHODS
+
+Mainly listed here to shut up the pitiful screams of the pod coverage tests.
+They keep me awake at night.
+
+=over 4
+
+=item * C<as_string>
+
+=item * C<raw>
+
+=back
+
+=cut
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<data>
+
+ if ( $result->is_yaml ) {
+ print $result->data;
+ }
+
+Return the parsed YAML data for this result
+
+=cut
+
+sub data { shift->{data} }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/ResultFactory.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/ResultFactory.pm
new file mode 100755
index 0000000000..ff7ef4addb
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/ResultFactory.pm
@@ -0,0 +1,183 @@
+package TAP::Parser::ResultFactory;
+
+use strict;
+use warnings;
+
+use TAP::Parser::Result::Bailout ();
+use TAP::Parser::Result::Comment ();
+use TAP::Parser::Result::Plan ();
+use TAP::Parser::Result::Pragma ();
+use TAP::Parser::Result::Test ();
+use TAP::Parser::Result::Unknown ();
+use TAP::Parser::Result::Version ();
+use TAP::Parser::Result::YAML ();
+
+use base 'TAP::Object';
+
+##############################################################################
+
+=head1 NAME
+
+TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::ResultFactory;
+ my $token = {...};
+ my $factory = TAP::Parser::ResultFactory->new;
+ my $result = $factory->make_result( $token );
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head2 DESCRIPTION
+
+This is a simple factory class which returns a L<TAP::Parser::Result> subclass
+representing the current bit of test data from TAP (usually a single line).
+It is used primarily by L<TAP::Parser::Grammar>. Unless you're subclassing,
+you probably won't need to use this module directly.
+
+=head2 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Creates a new factory class.
+I<Note:> You currently don't need to instantiate a factory in order to use it.
+
+=head3 C<make_result>
+
+Returns an instance the appropriate class for the test token passed in.
+
+ my $result = TAP::Parser::ResultFactory->make_result($token);
+
+Can also be called as an instance method.
+
+=cut
+
+sub make_result {
+ my ( $proto, $token ) = @_;
+ my $type = $token->{type};
+ return $proto->class_for($type)->new($token);
+}
+
+=head3 C<class_for>
+
+Takes one argument: C<$type>. Returns the class for this $type, or C<croak>s
+with an error.
+
+=head3 C<register_type>
+
+Takes two arguments: C<$type>, C<$class>
+
+This lets you override an existing type with your own custom type, or register
+a completely new type, eg:
+
+ # create a custom result type:
+ package MyResult;
+ use strict;
+ use base 'TAP::Parser::Result';
+
+ # register with the factory:
+ TAP::Parser::ResultFactory->register_type( 'my_type' => __PACKAGE__ );
+
+ # use it:
+ my $r = TAP::Parser::ResultFactory->( { type => 'my_type' } );
+
+Your custom type should then be picked up automatically by the L<TAP::Parser>.
+
+=cut
+
+our %CLASS_FOR = (
+ plan => 'TAP::Parser::Result::Plan',
+ pragma => 'TAP::Parser::Result::Pragma',
+ test => 'TAP::Parser::Result::Test',
+ comment => 'TAP::Parser::Result::Comment',
+ bailout => 'TAP::Parser::Result::Bailout',
+ version => 'TAP::Parser::Result::Version',
+ unknown => 'TAP::Parser::Result::Unknown',
+ yaml => 'TAP::Parser::Result::YAML',
+);
+
+sub class_for {
+ my ( $class, $type ) = @_;
+
+ # return target class:
+ return $CLASS_FOR{$type} if exists $CLASS_FOR{$type};
+
+ # or complain:
+ require Carp;
+ Carp::croak("Could not determine class for result type '$type'");
+}
+
+sub register_type {
+ my ( $class, $type, $rclass ) = @_;
+
+ # register it blindly, assume they know what they're doing
+ $CLASS_FOR{$type} = $rclass;
+ return $class;
+}
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+There are a few things to bear in mind when creating your own
+C<ResultFactory>:
+
+=over 4
+
+=item 1
+
+The factory itself is never instantiated (this I<may> change in the future).
+This means that C<_initialize> is never called.
+
+=item 2
+
+C<TAP::Parser::Result-E<gt>new> is never called, $tokens are reblessed.
+This I<will> change in a future version!
+
+=item 3
+
+L<TAP::Parser::Result> subclasses will register themselves with
+L<TAP::Parser::ResultFactory> directly:
+
+ package MyFooResult;
+ TAP::Parser::ResultFactory->register_type( foo => __PACKAGE__ );
+
+Of course, it's up to you to decide whether or not to ignore them.
+
+=back
+
+=head2 Example
+
+ package MyResultFactory;
+
+ use strict;
+
+ use MyResult;
+
+ use base 'TAP::Parser::ResultFactory';
+
+ # force all results to be 'MyResult'
+ sub class_for {
+ return 'MyResult';
+ }
+
+ 1;
+
+=head1 SEE ALSO
+
+L<TAP::Parser>,
+L<TAP::Parser::Result>,
+L<TAP::Parser::Grammar>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler.pm
new file mode 100755
index 0000000000..e7afbf6d62
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler.pm
@@ -0,0 +1,448 @@
+package TAP::Parser::Scheduler;
+
+use strict;
+use warnings;
+
+use Carp;
+use TAP::Parser::Scheduler::Job;
+use TAP::Parser::Scheduler::Spinner;
+
+=head1 NAME
+
+TAP::Parser::Scheduler - Schedule tests during parallel testing
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Scheduler;
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $sched = TAP::Parser::Scheduler->new(tests => \@tests);
+ my $sched = TAP::Parser::Scheduler->new(
+ tests => [ ['t/test_name.t','Test Description'], ... ],
+ rules => \%rules,
+ );
+
+Given 'tests' and optional 'rules' as input, returns a new
+C<TAP::Parser::Scheduler> object. Each member of C<@tests> should be either a
+a test file name, or a two element arrayref, where the first element is a test
+file name, and the second element is a test description. By default, we'll use
+the test name as the description.
+
+The optional C<rules> attribute provides direction on which tests should be run
+in parallel and which should be run sequentially. If no rule data structure is
+provided, a default data structure is used which makes every test eligible to
+be run in parallel:
+
+ { par => '**' },
+
+The rules data structure is documented more in the next section.
+
+=head2 Rules data structure
+
+The "C<rules>" data structure is the the heart of the scheduler. It allows you
+to express simple rules like "run all tests in sequence" or "run all tests in
+parallel except these five tests.". However, the rules structure also supports
+glob-style pattern matching and recursive definitions, so you can also express
+arbitarily complicated patterns.
+
+The rule must only have one top level key: either 'par' for "parallel" or 'seq'
+for "sequence".
+
+Values must be either strings with possible glob-style matching, or arrayrefs
+of strings or hashrefs which follow this pattern recursively.
+
+Every element in an arrayref directly below a 'par' key is eligible to be run
+in parallel, while vavalues directly below a 'seq' key must be run in sequence.
+
+=head3 Rules examples
+
+Here are some examples:
+
+ # All tests be run in parallel (the default rule)
+ { par => '**' },
+
+ # Run all tests in sequence, except those starting with "p"
+ { par => 't/p*.t' },
+
+ # Run all tests in parallel, except those starting with "p"
+ {
+ seq => [
+ { seq => 't/p*.t' },
+ { par => '**' },
+ ],
+ }
+
+ # Run some startup tests in sequence, then some parallel tests then some
+ # teardown tests in sequence.
+ {
+ seq => [
+ { seq => 't/startup/*.t' },
+ { par => ['t/a/*.t','t/b/*.t','t/c/*.t'], }
+ { seq => 't/shutdown/*.t' },
+ ],
+ },
+
+
+=head3 Rules resolution
+
+=over 4
+
+=item * By default, all tests are eligible to be run in parallel. Specifying any of your own rules removes this one.
+
+=item * "First match wins". The first rule that matches a test will be the one that applies.
+
+=item * Any test which does not match a rule will be run in sequence at the end of the run.
+
+=item * The existence of a rule does not imply selecting a test. You must still specify the tests to run.
+
+=item * Specifying a rule to allow tests to run in parallel does not make the run in parallel. You still need specify the number of parallel C<jobs> in your Harness object.
+
+=back
+
+=head3 Glob-style pattern matching for rules
+
+We implement our own glob-style pattern matching. Here are the patterns it supports:
+
+ ** is any number of characters, including /, within a pathname
+ * is zero or more characters within a filename/directory name
+ ? is exactly one character within a filename/directory name
+ {foo,bar,baz} is any of foo, bar or baz.
+ \ is an escape character
+
+=cut
+
+sub new {
+ my $class = shift;
+
+ croak "Need a number of key, value pairs" if @_ % 2;
+
+ my %args = @_;
+ my $tests = delete $args{tests} || croak "Need a 'tests' argument";
+ my $rules = delete $args{rules} || { par => '**' };
+
+ croak "Unknown arg(s): ", join ', ', sort keys %args
+ if keys %args;
+
+ # Turn any simple names into a name, description pair. TODO: Maybe
+ # construct jobs here?
+ my $self = bless {}, $class;
+
+ $self->_set_rules( $rules, $tests );
+
+ return $self;
+}
+
+# Build the scheduler data structure.
+#
+# SCHEDULER-DATA ::= JOB
+# || ARRAY OF ARRAY OF SCHEDULER-DATA
+#
+# The nested arrays are the key to scheduling. The outer array contains
+# a list of things that may be executed in parallel. Whenever an
+# eligible job is sought any element of the outer array that is ready to
+# execute can be selected. The inner arrays represent sequential
+# execution. They can only proceed when the first job is ready to run.
+
+sub _set_rules {
+ my ( $self, $rules, $tests ) = @_;
+
+ # Convert all incoming tests to job objects.
+ # If no test description is provided use the file name as the description.
+ my @tests = map { TAP::Parser::Scheduler::Job->new(@$_) }
+ map { 'ARRAY' eq ref $_ ? $_ : [ $_, $_ ] } @$tests;
+ my $schedule = $self->_rule_clause( $rules, \@tests );
+
+ # If any tests are left add them as a sequential block at the end of
+ # the run.
+ $schedule = [ [ $schedule, @tests ] ] if @tests;
+
+ $self->{schedule} = $schedule;
+}
+
+sub _rule_clause {
+ my ( $self, $rule, $tests ) = @_;
+ croak 'Rule clause must be a hash'
+ unless 'HASH' eq ref $rule;
+
+ my @type = keys %$rule;
+ croak 'Rule clause must have exactly one key'
+ unless @type == 1;
+
+ my %handlers = (
+ par => sub {
+ [ map { [$_] } @_ ];
+ },
+ seq => sub { [ [@_] ] },
+ );
+
+ my $handler = $handlers{ $type[0] }
+ || croak 'Unknown scheduler type: ', $type[0];
+ my $val = $rule->{ $type[0] };
+
+ return $handler->(
+ map {
+ 'HASH' eq ref $_
+ ? $self->_rule_clause( $_, $tests )
+ : $self->_expand( $_, $tests )
+ } 'ARRAY' eq ref $val ? @$val : $val
+ );
+}
+
+sub _glob_to_regexp {
+ my ( $self, $glob ) = @_;
+ my $nesting;
+ my $pattern;
+
+ while (1) {
+ if ( $glob =~ /\G\*\*/gc ) {
+
+ # ** is any number of characters, including /, within a pathname
+ $pattern .= '.*?';
+ }
+ elsif ( $glob =~ /\G\*/gc ) {
+
+ # * is zero or more characters within a filename/directory name
+ $pattern .= '[^/]*';
+ }
+ elsif ( $glob =~ /\G\?/gc ) {
+
+ # ? is exactly one character within a filename/directory name
+ $pattern .= '[^/]';
+ }
+ elsif ( $glob =~ /\G\{/gc ) {
+
+ # {foo,bar,baz} is any of foo, bar or baz.
+ $pattern .= '(?:';
+ ++$nesting;
+ }
+ elsif ( $nesting and $glob =~ /\G,/gc ) {
+
+ # , is only special inside {}
+ $pattern .= '|';
+ }
+ elsif ( $nesting and $glob =~ /\G\}/gc ) {
+
+ # } that matches { is special. But unbalanced } are not.
+ $pattern .= ')';
+ --$nesting;
+ }
+ elsif ( $glob =~ /\G(\\.)/gc ) {
+
+ # A quoted literal
+ $pattern .= $1;
+ }
+ elsif ( $glob =~ /\G([\},])/gc ) {
+
+ # Sometimes meta characters
+ $pattern .= '\\' . $1;
+ }
+ else {
+
+ # Eat everything that is not a meta character.
+ $glob =~ /\G([^{?*\\\},]*)/gc;
+ $pattern .= quotemeta $1;
+ }
+ return $pattern if pos $glob == length $glob;
+ }
+}
+
+sub _expand {
+ my ( $self, $name, $tests ) = @_;
+
+ my $pattern = $self->_glob_to_regexp($name);
+ $pattern = qr/^ $pattern $/x;
+ my @match = ();
+
+ for ( my $ti = 0; $ti < @$tests; $ti++ ) {
+ if ( $tests->[$ti]->filename =~ $pattern ) {
+ push @match, splice @$tests, $ti, 1;
+ $ti--;
+ }
+ }
+
+ return @match;
+}
+
+=head2 Instance Methods
+
+=head3 C<get_all>
+
+Get a list of all remaining tests.
+
+=cut
+
+sub get_all {
+ my $self = shift;
+ my @all = $self->_gather( $self->{schedule} );
+ $self->{count} = @all;
+ @all;
+}
+
+sub _gather {
+ my ( $self, $rule ) = @_;
+ return unless defined $rule;
+ return $rule unless 'ARRAY' eq ref $rule;
+ return map { defined() ? $self->_gather($_) : () } map {@$_} @$rule;
+}
+
+=head3 C<get_job>
+
+Return the next available job as L<TAP::Parser::Scheduler::Job> object or
+C<undef> if none are available. Returns a L<TAP::Parser::Scheduler::Spinner> if
+the scheduler still has pending jobs but none are available to run right now.
+
+=cut
+
+sub get_job {
+ my $self = shift;
+ $self->{count} ||= $self->get_all;
+ my @jobs = $self->_find_next_job( $self->{schedule} );
+ if (@jobs) {
+ --$self->{count};
+ return $jobs[0];
+ }
+
+ return TAP::Parser::Scheduler::Spinner->new
+ if $self->{count};
+
+ return;
+}
+
+sub _not_empty {
+ my $ar = shift;
+ return 1 unless 'ARRAY' eq ref $ar;
+ for (@$ar) {
+ return 1 if _not_empty($_);
+ }
+ return;
+}
+
+sub _is_empty { !_not_empty(@_) }
+
+sub _find_next_job {
+ my ( $self, $rule ) = @_;
+
+ my @queue = ();
+ my $index = 0;
+ while ( $index < @$rule ) {
+ my $seq = $rule->[$index];
+
+ # Prune any exhausted items.
+ shift @$seq while @$seq && _is_empty( $seq->[0] );
+ if (@$seq) {
+ if ( defined $seq->[0] ) {
+ if ( 'ARRAY' eq ref $seq->[0] ) {
+ push @queue, $seq;
+ }
+ else {
+ my $job = splice @$seq, 0, 1, undef;
+ $job->on_finish( sub { shift @$seq } );
+ return $job;
+ }
+ }
+ ++$index;
+ }
+ else {
+
+ # Remove the empty sub-array from the array
+ splice @$rule, $index, 1;
+ }
+ }
+
+ for my $seq (@queue) {
+ if ( my @jobs = $self->_find_next_job( $seq->[0] ) ) {
+ return @jobs;
+ }
+ }
+
+ return;
+}
+
+=head3 C<as_string>
+
+Return a human readable representation of the scheduling tree.
+For example:
+
+ my @tests = (qw{
+ t/startup/foo.t
+ t/shutdown/foo.t
+
+ t/a/foo.t t/b/foo.t t/c/foo.t t/d/foo.t
+ });
+ my $sched = TAP::Parser::Scheduler->new(
+ tests => \@tests,
+ rules => {
+ seq => [
+ { seq => 't/startup/*.t' },
+ { par => ['t/a/*.t','t/b/*.t','t/c/*.t'] },
+ { seq => 't/shutdown/*.t' },
+ ],
+ },
+ );
+
+Produces:
+
+ par:
+ seq:
+ par:
+ seq:
+ par:
+ seq:
+ 't/startup/foo.t'
+ par:
+ seq:
+ 't/a/foo.t'
+ seq:
+ 't/b/foo.t'
+ seq:
+ 't/c/foo.t'
+ par:
+ seq:
+ 't/shutdown/foo.t'
+ 't/d/foo.t'
+
+
+=cut
+
+
+sub as_string {
+ my $self = shift;
+ return $self->_as_string( $self->{schedule} );
+}
+
+sub _as_string {
+ my ( $self, $rule, $depth ) = ( shift, shift, shift || 0 );
+ my $pad = ' ' x 2;
+ my $indent = $pad x $depth;
+ if ( !defined $rule ) {
+ return "$indent(undef)\n";
+ }
+ elsif ( 'ARRAY' eq ref $rule ) {
+ return unless @$rule;
+ my $type = ( 'par', 'seq' )[ $depth % 2 ];
+ return join(
+ '', "$indent$type:\n",
+ map { $self->_as_string( $_, $depth + 1 ) } @$rule
+ );
+ }
+ else {
+ return "$indent'" . $rule->filename . "'\n";
+ }
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Job.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Job.pm
new file mode 100755
index 0000000000..e05661d719
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Job.pm
@@ -0,0 +1,127 @@
+package TAP::Parser::Scheduler::Job;
+
+use strict;
+use warnings;
+use Carp;
+
+=head1 NAME
+
+TAP::Parser::Scheduler::Job - A single testing job.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Scheduler::Job;
+
+=head1 DESCRIPTION
+
+Represents a single test 'job'.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $job = TAP::Parser::Scheduler::Job->new(
+ $filename, $description
+ );
+
+Given the filename and description of a test as scalars, returns a new
+L<TAP::Parser::Scheduler::Job> object.
+
+=cut
+
+sub new {
+ my ( $class, $name, $desc, @ctx ) = @_;
+ return bless {
+ filename => $name,
+ description => $desc,
+ @ctx ? ( context => \@ctx ) : (),
+ }, $class;
+}
+
+=head2 Instance Methods
+
+=head3 C<on_finish>
+
+ $self->on_finish(\&method).
+
+Register a closure to be called when this job is destroyed. The callback
+will be passed the C<TAP::Parser::Scheduler::Job> object as it's only argument.
+
+=cut
+
+sub on_finish {
+ my ( $self, $cb ) = @_;
+ $self->{on_finish} = $cb;
+}
+
+=head3 C<finish>
+
+ $self->finish;
+
+Called when a job is complete to unlock it. If a callback has been registered
+with C<on_finish>, it calls it. Otherwise, it does nothing.
+
+=cut
+
+sub finish {
+ my $self = shift;
+ if ( my $cb = $self->{on_finish} ) {
+ $cb->($self);
+ }
+}
+
+=head2 Attributes
+
+ $self->filename;
+ $self->description;
+ $self->context;
+
+These are all "getters" which return the data set for these attributes during object construction.
+
+
+=head3 C<filename>
+
+=head3 C<description>
+
+=head3 C<context>
+
+=cut
+
+sub filename { shift->{filename} }
+sub description { shift->{description} }
+sub context { @{ shift->{context} || [] } }
+
+=head3 C<as_array_ref>
+
+For backwards compatibility in callbacks.
+
+=cut
+
+sub as_array_ref {
+ my $self = shift;
+ return [ $self->filename, $self->description, $self->{context} ||= [] ];
+}
+
+=head3 C<is_spinner>
+
+ $self->is_spinner;
+
+Returns false indicating that this is a real job rather than a
+'spinner'. Spinners are returned when the scheduler still has pending
+jobs but can't (because of locking) return one right now.
+
+=cut
+
+sub is_spinner {0}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Spinner.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Spinner.pm
new file mode 100755
index 0000000000..3d8be9ee4d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Scheduler/Spinner.pm
@@ -0,0 +1,61 @@
+package TAP::Parser::Scheduler::Spinner;
+
+use strict;
+use warnings;
+use Carp;
+
+=head1 NAME
+
+TAP::Parser::Scheduler::Spinner - A no-op job.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Scheduler::Spinner;
+
+=head1 DESCRIPTION
+
+A no-op job. Returned by C<TAP::Parser::Scheduler> as an instruction to
+the harness to spin (keep executing tests) while the scheduler can't
+return a real job.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $job = TAP::Parser::Scheduler::Spinner->new;
+
+Ignores any arguments and returns a new C<TAP::Parser::Scheduler::Spinner> object.
+
+=cut
+
+sub new { bless {}, shift }
+
+=head2 Instance Methods
+
+=head3 C<is_spinner>
+
+Returns true indicating that is a 'spinner' job. Spinners are returned
+when the scheduler still has pending jobs but can't (because of locking)
+return one right now.
+
+=cut
+
+sub is_spinner {1}
+
+=head1 SEE ALSO
+
+L<TAP::Parser::Scheduler>, L<TAP::Parser::Scheduler::Job>
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Source.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Source.pm
new file mode 100755
index 0000000000..bed0e80d1f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/Source.pm
@@ -0,0 +1,381 @@
+package TAP::Parser::Source;
+
+use strict;
+use warnings;
+
+use File::Basename qw( fileparse );
+use base 'TAP::Object';
+
+use constant BLK_SIZE => 512;
+
+=head1 NAME
+
+TAP::Parser::Source - a TAP source & meta data about it
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ my $source = TAP::Parser::Source->new;
+ $source->raw( \'reference to raw TAP source' )
+ ->config( \%config )
+ ->merge( $boolean )
+ ->switches( \@switches )
+ ->test_args( \@args )
+ ->assemble_meta;
+
+ do { ... } if $source->meta->{is_file};
+ # see assemble_meta for a full list of data available
+
+=head1 DESCRIPTION
+
+A TAP I<source> is something that produces a stream of TAP for the parser to
+consume, such as an executable file, a text file, an archive, an IO handle, a
+database, etc. C<TAP::Parser::Source>s encapsulate these I<raw> sources, and
+provide some useful meta data about them. They are used by
+L<TAP::Parser::SourceHandler>s, which do whatever is required to produce &
+capture a stream of TAP from the I<raw> source, and package it up in a
+L<TAP::Parser::Iterator> for the parser to consume.
+
+Unless you're writing a new L<TAP::Parser::SourceHandler>, a plugin or
+subclassing L<TAP::Parser>, you probably won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $source = TAP::Parser::Source->new;
+
+Returns a new C<TAP::Parser::Source> object.
+
+=cut
+
+# new() implementation supplied by TAP::Object
+
+sub _initialize {
+ my ($self) = @_;
+ $self->meta( {} );
+ $self->config( {} );
+ return $self;
+}
+
+##############################################################################
+
+=head2 Instance Methods
+
+=head3 C<raw>
+
+ my $raw = $source->raw;
+ $source->raw( $some_value );
+
+Chaining getter/setter for the raw TAP source. This is a reference, as it may
+contain large amounts of data (eg: raw TAP).
+
+=head3 C<meta>
+
+ my $meta = $source->meta;
+ $source->meta({ %some_value });
+
+Chaining getter/setter for meta data about the source. This defaults to an
+empty hashref. See L</assemble_meta> for more info.
+
+=head3 C<has_meta>
+
+True if the source has meta data.
+
+=head3 C<config>
+
+ my $config = $source->config;
+ $source->config({ %some_value });
+
+Chaining getter/setter for the source's configuration, if any has been provided
+by the user. How it's used is up to you. This defaults to an empty hashref.
+See L</config_for> for more info.
+
+=head3 C<merge>
+
+ my $merge = $source->merge;
+ $source->config( $bool );
+
+Chaining getter/setter for the flag that dictates whether STDOUT and STDERR
+should be merged (where appropriate). Defaults to undef.
+
+=head3 C<switches>
+
+ my $switches = $source->switches;
+ $source->config([ @switches ]);
+
+Chaining getter/setter for the list of command-line switches that should be
+passed to the source (where appropriate). Defaults to undef.
+
+=head3 C<test_args>
+
+ my $test_args = $source->test_args;
+ $source->config([ @test_args ]);
+
+Chaining getter/setter for the list of command-line arguments that should be
+passed to the source (where appropriate). Defaults to undef.
+
+=cut
+
+sub raw {
+ my $self = shift;
+ return $self->{raw} unless @_;
+ $self->{raw} = shift;
+ return $self;
+}
+
+sub meta {
+ my $self = shift;
+ return $self->{meta} unless @_;
+ $self->{meta} = shift;
+ return $self;
+}
+
+sub has_meta {
+ return scalar %{ shift->meta } ? 1 : 0;
+}
+
+sub config {
+ my $self = shift;
+ return $self->{config} unless @_;
+ $self->{config} = shift;
+ return $self;
+}
+
+sub merge {
+ my $self = shift;
+ return $self->{merge} unless @_;
+ $self->{merge} = shift;
+ return $self;
+}
+
+sub switches {
+ my $self = shift;
+ return $self->{switches} unless @_;
+ $self->{switches} = shift;
+ return $self;
+}
+
+sub test_args {
+ my $self = shift;
+ return $self->{test_args} unless @_;
+ $self->{test_args} = shift;
+ return $self;
+}
+
+=head3 C<assemble_meta>
+
+ my $meta = $source->assemble_meta;
+
+Gathers meta data about the L</raw> source, stashes it in L</meta> and returns
+it as a hashref. This is done so that the L<TAP::Parser::SourceHandler>s don't
+have to repeat common checks. Currently this includes:
+
+ is_scalar => $bool,
+ is_hash => $bool,
+ is_array => $bool,
+
+ # for scalars:
+ length => $n
+ has_newlines => $bool
+
+ # only done if the scalar looks like a filename
+ is_file => $bool,
+ is_dir => $bool,
+ is_symlink => $bool,
+ file => {
+ # only done if the scalar looks like a filename
+ basename => $string, # including ext
+ dir => $string,
+ ext => $string,
+ lc_ext => $string,
+ # system checks
+ exists => $bool,
+ stat => [ ... ], # perldoc -f stat
+ empty => $bool,
+ size => $n,
+ text => $bool,
+ binary => $bool,
+ read => $bool,
+ write => $bool,
+ execute => $bool,
+ setuid => $bool,
+ setgid => $bool,
+ sticky => $bool,
+ is_file => $bool,
+ is_dir => $bool,
+ is_symlink => $bool,
+ # only done if the file's a symlink
+ lstat => [ ... ], # perldoc -f lstat
+ # only done if the file's a readable text file
+ shebang => $first_line,
+ }
+
+ # for arrays:
+ size => $n,
+
+=cut
+
+sub assemble_meta {
+ my ($self) = @_;
+
+ return $self->meta if $self->has_meta;
+
+ my $meta = $self->meta;
+ my $raw = $self->raw;
+
+ # rudimentary is object test - if it's blessed it'll
+ # inherit from UNIVERSAL
+ $meta->{is_object} = UNIVERSAL::isa( $raw, 'UNIVERSAL' ) ? 1 : 0;
+
+ if ( $meta->{is_object} ) {
+ $meta->{class} = ref($raw);
+ }
+ else {
+ my $ref = lc( ref($raw) );
+ $meta->{"is_$ref"} = 1;
+ }
+
+ if ( $meta->{is_scalar} ) {
+ my $source = $$raw;
+ $meta->{length} = length($$raw);
+ $meta->{has_newlines} = $$raw =~ /\n/ ? 1 : 0;
+
+ # only do file checks if it looks like a filename
+ if ( !$meta->{has_newlines} and $meta->{length} < 1024 ) {
+ my $file = {};
+ $file->{exists} = -e $source ? 1 : 0;
+ if ( $file->{exists} ) {
+ $meta->{file} = $file;
+
+ # avoid extra system calls (see `perldoc -f -X`)
+ $file->{stat} = [ stat(_) ];
+ $file->{empty} = -z _ ? 1 : 0;
+ $file->{size} = -s _;
+ $file->{text} = -T _ ? 1 : 0;
+ $file->{binary} = -B _ ? 1 : 0;
+ $file->{read} = -r _ ? 1 : 0;
+ $file->{write} = -w _ ? 1 : 0;
+ $file->{execute} = -x _ ? 1 : 0;
+ $file->{setuid} = -u _ ? 1 : 0;
+ $file->{setgid} = -g _ ? 1 : 0;
+ $file->{sticky} = -k _ ? 1 : 0;
+
+ $meta->{is_file} = $file->{is_file} = -f _ ? 1 : 0;
+ $meta->{is_dir} = $file->{is_dir} = -d _ ? 1 : 0;
+
+ # symlink check requires another system call
+ $meta->{is_symlink} = $file->{is_symlink}
+ = -l $source ? 1 : 0;
+ if ( $file->{is_symlink} ) {
+ $file->{lstat} = [ lstat(_) ];
+ }
+
+ # put together some common info about the file
+ ( $file->{basename}, $file->{dir}, $file->{ext} )
+ = map { defined $_ ? $_ : '' }
+ fileparse( $source, qr/\.[^.]*/ );
+ $file->{lc_ext} = lc( $file->{ext} );
+ $file->{basename} .= $file->{ext} if $file->{ext};
+
+ if ( !$file->{is_dir} && $file->{read} ) {
+ eval { $file->{shebang} = $self->shebang($$raw); };
+ if ( my $e = $@ ) {
+ warn $e;
+ }
+ }
+ }
+ }
+ }
+ elsif ( $meta->{is_array} ) {
+ $meta->{size} = $#$raw + 1;
+ }
+ elsif ( $meta->{is_hash} ) {
+ ; # do nothing
+ }
+
+ return $meta;
+}
+
+=head3 C<shebang>
+
+Get the shebang line for a script file.
+
+ my $shebang = TAP::Parser::Source->shebang( $some_script );
+
+May be called as a class method
+
+=cut
+
+{
+
+ # Global shebang cache.
+ my %shebang_for;
+
+ sub _read_shebang {
+ my ( $class, $file ) = @_;
+ open my $fh, '<', $file or die "Can't read $file: $!\n";
+
+ # Might be a binary file - so read a fixed number of bytes.
+ my $got = read $fh, my ($buf), BLK_SIZE;
+ defined $got or die "I/O error: $!\n";
+ return $1 if $buf =~ /(.*)/;
+ return;
+ }
+
+ sub shebang {
+ my ( $class, $file ) = @_;
+ $shebang_for{$file} = $class->_read_shebang($file)
+ unless exists $shebang_for{$file};
+ return $shebang_for{$file};
+ }
+}
+
+=head3 C<config_for>
+
+ my $config = $source->config_for( $class );
+
+Returns L</config> for the $class given. Class names may be fully qualified
+or abbreviated, eg:
+
+ # these are equivalent
+ $source->config_for( 'Perl' );
+ $source->config_for( 'TAP::Parser::SourceHandler::Perl' );
+
+If a fully qualified $class is given, its abbreviated version is checked first.
+
+=cut
+
+sub config_for {
+ my ( $self, $class ) = @_;
+ my ($abbrv_class) = ( $class =~ /(?:\:\:)?(\w+)$/ );
+ my $config = $self->config->{$abbrv_class} || $self->config->{$class};
+ return $config;
+}
+
+1;
+
+__END__
+
+=head1 AUTHORS
+
+Steve Purkis.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler.pm
new file mode 100755
index 0000000000..4d537550c2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler.pm
@@ -0,0 +1,191 @@
+package TAP::Parser::SourceHandler;
+
+use strict;
+use warnings;
+
+use TAP::Parser::Iterator ();
+use base 'TAP::Object';
+
+=head1 NAME
+
+TAP::Parser::SourceHandler - Base class for different TAP source handlers
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ # abstract class - don't use directly!
+ # see TAP::Parser::IteratorFactory for general usage
+
+ # must be sub-classed for use
+ package MySourceHandler;
+ use base 'TAP::Parser::SourceHandler';
+ sub can_handle { return $confidence_level }
+ sub make_iterator { return $iterator }
+
+ # see example below for more details
+
+=head1 DESCRIPTION
+
+This is an abstract base class for L<TAP::Parser::Source> handlers / handlers.
+
+A C<TAP::Parser::SourceHandler> does whatever is necessary to produce & capture
+a stream of TAP from the I<raw> source, and package it up in a
+L<TAP::Parser::Iterator> for the parser to consume.
+
+C<SourceHandlers> must implement the I<source detection & handling> interface
+used by L<TAP::Parser::IteratorFactory>. At 2 methods, the interface is pretty
+simple: L</can_handle> and L</make_source>.
+
+Unless you're writing a new L<TAP::Parser::SourceHandler>, a plugin, or
+subclassing L<TAP::Parser>, you probably won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+I<Abstract method>.
+
+ my $vote = $class->can_handle( $source );
+
+C<$source> is a L<TAP::Parser::Source>.
+
+Returns a number between C<0> & C<1> reflecting how confidently the raw source
+can be handled. For example, C<0> means the source cannot handle it, C<0.5>
+means it may be able to, and C<1> means it definitely can. See
+L<TAP::Parser::IteratorFactory/detect_source> for details on how this is used.
+
+=cut
+
+sub can_handle {
+ my ( $class, $args ) = @_;
+ $class->_croak(
+ "Abstract method 'can_handle' not implemented for $class!");
+ return;
+}
+
+=head3 C<make_iterator>
+
+I<Abstract method>.
+
+ my $iterator = $class->make_iterator( $source );
+
+C<$source> is a L<TAP::Parser::Source>.
+
+Returns a new L<TAP::Parser::Iterator> object for use by the L<TAP::Parser>.
+C<croak>s on error.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $args ) = @_;
+ $class->_croak(
+ "Abstract method 'make_iterator' not implemented for $class!");
+ return;
+}
+1;
+
+__END__
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview, and any
+of the subclasses that ship with this module as an example. What follows is
+a quick overview.
+
+Start by familiarizing yourself with L<TAP::Parser::Source> and
+L<TAP::Parser::IteratorFactory>. L<TAP::Parser::SourceHandler::RawTAP> is
+the easiest sub-class to use as an example.
+
+It's important to point out that if you want your subclass to be automatically
+used by L<TAP::Parser> you'll have to and make sure it gets loaded somehow.
+If you're using L<prove> you can write an L<App::Prove> plugin. If you're
+using L<TAP::Parser> or L<TAP::Harness> directly (e.g. through a custom script,
+L<ExtUtils::MakeMaker>, or L<Module::Build>) you can use the C<config> option
+which will cause L<TAP::Parser::IteratorFactory/load_sources> to load your
+subclass).
+
+Don't forget to register your class with
+L<TAP::Parser::IteratorFactory/register_handler>.
+
+=head2 Example
+
+ package MySourceHandler;
+
+ use strict;
+
+ use MySourceHandler; # see TAP::Parser::SourceHandler
+ use TAP::Parser::IteratorFactory;
+
+ use base 'TAP::Parser::SourceHandler';
+
+ TAP::Parser::IteratorFactory->register_handler( __PACKAGE__ );
+
+ sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+ my $config = $src->config_for( $class );
+
+ if ($config->{accept_all}) {
+ return 1.0;
+ } elsif (my $file = $meta->{file}) {
+ return 0.0 unless $file->{exists};
+ return 1.0 if $file->{lc_ext} eq '.tap';
+ return 0.9 if $file->{shebang} && $file->{shebang} =~ /^#!.+tap/;
+ return 0.5 if $file->{text};
+ return 0.1 if $file->{binary};
+ } elsif ($meta->{scalar}) {
+ return 0.8 if $$raw_source_ref =~ /\d\.\.\d/;
+ return 0.6 if $meta->{has_newlines};
+ } elsif ($meta->{array}) {
+ return 0.8 if $meta->{size} < 5;
+ return 0.6 if $raw_source_ref->[0] =~ /foo/;
+ return 0.5;
+ } elsif ($meta->{hash}) {
+ return 0.6 if $raw_source_ref->{foo};
+ return 0.2;
+ }
+
+ return 0;
+ }
+
+ sub make_iterator {
+ my ($class, $source) = @_;
+ # this is where you manipulate the source and
+ # capture the stream of TAP in an iterator
+ # either pick a TAP::Parser::Iterator::* or write your own...
+ my $iterator = TAP::Parser::Iterator::Array->new([ 'foo', 'bar' ]);
+ return $iterator;
+ }
+
+ 1;
+
+=head1 AUTHORS
+
+TAPx Developers.
+
+Source detection stuff added by Steve Purkis
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Source>,
+L<TAP::Parser::Iterator>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Executable.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Executable.pm
new file mode 100755
index 0000000000..e191545732
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Executable.pm
@@ -0,0 +1,187 @@
+package TAP::Parser::SourceHandler::Executable;
+
+use strict;
+use warnings;
+
+use File::Spec;
+
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Process ();
+
+use base 'TAP::Parser::SourceHandler';
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::Executable - Stream output from an executable TAP source
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::Executable;
+
+ my $source = TAP::Parser::Source->new->raw(['/usr/bin/ruby', 'mytest.rb']);
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::Executable';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is an I<executable> L<TAP::Parser::SourceHandler> - it has 2 jobs:
+
+1. Figure out if the L<TAP::Parser::Source> it's given is an executable
+ command (L</can_handle>).
+
+2. Creates an iterator for executable commands (L</make_iterator>).
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you
+probably won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Only votes if $source looks like an executable file. Casts the
+following votes:
+
+ 0.9 if it's a hash with an 'exec' key
+ 0.8 if it's a .bat file
+ 0.75 if it's got an execute bit set
+
+=cut
+
+sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+
+ if ( $meta->{is_file} ) {
+ my $file = $meta->{file};
+
+ return 0.85 if $file->{execute} && $file->{binary};
+ return 0.8 if $file->{lc_ext} eq '.bat';
+ return 0.25 if $file->{execute};
+ }
+ elsif ( $meta->{is_hash} ) {
+ return 0.9 if $src->raw->{exec};
+ }
+
+ return 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Process> for the source.
+C<$source-E<gt>raw> must be in one of the following forms:
+
+ { exec => [ @exec ] }
+
+ [ @exec ]
+
+ $file
+
+C<croak>s on error.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+ my $meta = $source->meta;
+
+ my @command;
+ if ( $meta->{is_hash} ) {
+ @command = @{ $source->raw->{exec} || [] };
+ }
+ elsif ( $meta->{is_scalar} ) {
+ @command = File::Spec->rel2abs( ${ $source->raw } )
+ if ${ $source->raw };
+ }
+ elsif ( $meta->{is_array} ) {
+ @command = @{ $source->raw };
+ }
+
+ $class->_croak('No command found in $source->raw!') unless @command;
+
+ $class->_autoflush( \*STDOUT );
+ $class->_autoflush( \*STDERR );
+
+ push @command, @{ $source->test_args || [] };
+
+ return $class->iterator_class->new(
+ { command => \@command,
+ merge => $source->merge
+ }
+ );
+}
+
+=head3 C<iterator_class>
+
+The class of iterator to use, override if you're sub-classing. Defaults
+to L<TAP::Parser::Iterator::Process>.
+
+=cut
+
+use constant iterator_class => 'TAP::Parser::Iterator::Process';
+
+# Turns on autoflush for the handle passed
+sub _autoflush {
+ my ( $class, $flushed ) = @_;
+ my $old_fh = select $flushed;
+ $| = 1;
+ select $old_fh;
+}
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head2 Example
+
+ package MyRubySourceHandler;
+
+ use strict;
+
+ use Carp qw( croak );
+ use TAP::Parser::SourceHandler::Executable;
+
+ use base 'TAP::Parser::SourceHandler::Executable';
+
+ # expect $handler->(['mytest.rb', 'cmdline', 'args']);
+ sub make_iterator {
+ my ($self, $source) = @_;
+ my @test_args = @{ $source->test_args };
+ my $rb_file = $test_args[0];
+ croak("error: Ruby file '$rb_file' not found!") unless (-f $rb_file);
+ return $self->SUPER::raw_source(['/usr/bin/ruby', @test_args]);
+ }
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/File.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/File.pm
new file mode 100755
index 0000000000..9e9684e71f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/File.pm
@@ -0,0 +1,136 @@
+package TAP::Parser::SourceHandler::File;
+
+use strict;
+use warnings;
+
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Stream ();
+
+use base 'TAP::Parser::SourceHandler';
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::File - Stream TAP from a text file.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::File;
+
+ my $source = TAP::Parser::Source->new->raw( \'file.tap' );
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::File';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is a I<raw TAP stored in a file> L<TAP::Parser::SourceHandler> - it has 2 jobs:
+
+1. Figure out if the I<raw> source it's given is a file containing raw TAP
+output. See L<TAP::Parser::IteratorFactory> for more details.
+
+2. Takes raw TAP from the text file given, and converts into an iterator.
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Only votes if $source looks like a regular file. Casts the following votes:
+
+ 0.9 if it's a .tap file
+ 0.9 if it has an extension matching any given in user config.
+
+=cut
+
+sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+ my $config = $src->config_for($class);
+
+ return 0 unless $meta->{is_file};
+ my $file = $meta->{file};
+ return 0.9 if $file->{lc_ext} eq '.tap';
+
+ if ( my $exts = $config->{extensions} ) {
+ my @exts = ref $exts eq 'ARRAY' ? @$exts : $exts;
+ return 0.9 if grep { lc($_) eq $file->{lc_ext} } @exts;
+ }
+
+ return 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Stream> for the source. C<croak>s
+on error.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+
+ $class->_croak('$source->raw must be a scalar ref')
+ unless $source->meta->{is_scalar};
+
+ my $file = ${ $source->raw };
+ my $fh;
+ open( $fh, '<', $file )
+ or $class->_croak("error opening TAP source file '$file': $!");
+ return $class->iterator_class->new($fh);
+}
+
+=head3 C<iterator_class>
+
+The class of iterator to use, override if you're sub-classing. Defaults
+to L<TAP::Parser::Iterator::Stream>.
+
+=cut
+
+use constant iterator_class => 'TAP::Parser::Iterator::Stream';
+
+1;
+
+__END__
+
+=head1 CONFIGURATION
+
+ {
+ extensions => [ @case_insensitive_exts_to_match ]
+ }
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Handle.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Handle.pm
new file mode 100755
index 0000000000..e01f8afa5b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Handle.pm
@@ -0,0 +1,124 @@
+package TAP::Parser::SourceHandler::Handle;
+
+use strict;
+use warnings;
+
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Stream ();
+
+use base 'TAP::Parser::SourceHandler';
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::Handle - Stream TAP from an IO::Handle or a GLOB.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::Executable;
+
+ my $source = TAP::Parser::Source->new->raw( \*TAP_FILE );
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::Handle';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is a I<raw TAP stored in an IO Handle> L<TAP::Parser::SourceHandler> class. It
+has 2 jobs:
+
+1. Figure out if the L<TAP::Parser::Source> it's given is an L<IO::Handle> or
+GLOB containing raw TAP output (L</can_handle>).
+
+2. Creates an iterator for IO::Handle's & globs (L</make_iterator>).
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Casts the following votes:
+
+ 0.9 if $source is an IO::Handle
+ 0.8 if $source is a glob
+
+=cut
+
+sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+
+ return 0.9
+ if $meta->{is_object}
+ && UNIVERSAL::isa( $src->raw, 'IO::Handle' );
+
+ return 0.8 if $meta->{is_glob};
+
+ return 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Stream> for the source.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+
+ $class->_croak('$source->raw must be a glob ref or an IO::Handle')
+ unless $source->meta->{is_glob}
+ || UNIVERSAL::isa( $source->raw, 'IO::Handle' );
+
+ return $class->iterator_class->new( $source->raw );
+}
+
+=head3 C<iterator_class>
+
+The class of iterator to use, override if you're sub-classing. Defaults
+to L<TAP::Parser::Iterator::Stream>.
+
+=cut
+
+use constant iterator_class => 'TAP::Parser::Iterator::Stream';
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::Iterator>,
+L<TAP::Parser::Iterator::Stream>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Perl.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Perl.pm
new file mode 100755
index 0000000000..6d9e91d0bd
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/Perl.pm
@@ -0,0 +1,372 @@
+package TAP::Parser::SourceHandler::Perl;
+
+use strict;
+use warnings;
+use Config;
+
+use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
+use constant IS_VMS => ( $^O eq 'VMS' );
+
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Process ();
+use Text::ParseWords qw(shellwords);
+
+use base 'TAP::Parser::SourceHandler::Executable';
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::Perl - Stream TAP from a Perl executable
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::Perl;
+
+ my $source = TAP::Parser::Source->new->raw( \'script.pl' );
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::Perl';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is a I<Perl> L<TAP::Parser::SourceHandler> - it has 2 jobs:
+
+1. Figure out if the L<TAP::Parser::Source> it's given is actually a Perl
+script (L</can_handle>).
+
+2. Creates an iterator for Perl sources (L</make_iterator>).
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Only votes if $source looks like a file. Casts the following votes:
+
+ 0.9 if it has a shebang ala "#!...perl"
+ 0.3 if it has any shebang
+ 0.8 if it's a .t file
+ 0.9 if it's a .pl file
+ 0.75 if it's in a 't' directory
+ 0.25 by default (backwards compat)
+
+=cut
+
+sub can_handle {
+ my ( $class, $source ) = @_;
+ my $meta = $source->meta;
+
+ return 0 unless $meta->{is_file};
+ my $file = $meta->{file};
+
+ my $shebang = $file->{shebang} || '';
+
+ if ( $shebang =~ /^#!/ ) {
+ return 0.9 if $shebang =~ /^#!.*\bperl/;
+
+ # We favour Perl as the interpreter for any shebang to preserve
+ # previous semantics: we used to execute everything via Perl and
+ # relied on it to pass the shebang off to the appropriate
+ # interpreter.
+ return 0.3;
+ }
+
+ return 0.8 if $file->{lc_ext} eq '.t'; # vote higher than Executable
+ return 0.9 if $file->{lc_ext} eq '.pl';
+
+ return 0.75 if $file->{dir} =~ /^t\b/; # vote higher than Executable
+
+ # backwards compat, always vote:
+ return 0.25;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Constructs & returns a new L<TAP::Parser::Iterator::Process> for the source.
+Assumes C<$source-E<gt>raw> contains a reference to the perl script. C<croak>s
+if the file could not be found.
+
+The command to run is built as follows:
+
+ $perl @switches $perl_script @test_args
+
+The perl command to use is determined by L</get_perl>. The command generated
+is guaranteed to preserve:
+
+ PERL5LIB
+ PERL5OPT
+ Taint Mode, if set in the script's shebang
+
+I<Note:> the command generated will I<not> respect any shebang line defined in
+your Perl script. This is only a problem if you have compiled a custom version
+of Perl or if you want to use a specific version of Perl for one test and a
+different version for another, for example:
+
+ #!/path/to/a/custom_perl --some --args
+ #!/usr/local/perl-5.6/bin/perl -w
+
+Currently you need to write a plugin to get around this.
+
+=cut
+
+sub _autoflush_stdhandles {
+ my ($class) = @_;
+
+ $class->_autoflush( \*STDOUT );
+ $class->_autoflush( \*STDERR );
+}
+
+sub make_iterator {
+ my ( $class, $source ) = @_;
+ my $meta = $source->meta;
+ my $perl_script = ${ $source->raw };
+
+ $class->_croak("Cannot find ($perl_script)") unless $meta->{is_file};
+
+ # TODO: does this really need to be done here?
+ $class->_autoflush_stdhandles;
+
+ my ( $libs, $switches )
+ = $class->_mangle_switches(
+ $class->_filter_libs( $class->_switches($source) ) );
+
+ $class->_run( $source, $libs, $switches );
+}
+
+
+sub _has_taint_switch {
+ my( $class, $switches ) = @_;
+
+ my $has_taint = grep { $_ eq "-T" || $_ eq "-t" } @{$switches};
+ return $has_taint ? 1 : 0;
+}
+
+sub _mangle_switches {
+ my ( $class, $libs, $switches ) = @_;
+
+ # Taint mode ignores environment variables so we must retranslate
+ # PERL5LIB as -I switches and place PERL5OPT on the command line
+ # in order that it be seen.
+ if ( $class->_has_taint_switch($switches) ) {
+ my @perl5lib = defined $ENV{PERL5LIB} ? split /$Config{path_sep}/, $ENV{PERL5LIB} : ();
+ return (
+ $libs,
+ [ @{$switches},
+ $class->_libs2switches([@$libs, @perl5lib]),
+ defined $ENV{PERL5OPT} ? shellwords( $ENV{PERL5OPT} ) : ()
+ ],
+ );
+ }
+
+ return ( $libs, $switches );
+}
+
+sub _filter_libs {
+ my ( $class, @switches ) = @_;
+
+ my $path_sep = $Config{path_sep};
+ my $path_re = qr{$path_sep};
+
+ # Filter out any -I switches to be handled as libs later.
+ #
+ # Nasty kludge. It might be nicer if we got the libs separately
+ # although at least this way we find any -I switches that were
+ # supplied other then as explicit libs.
+ #
+ # We filter out any names containing colons because they will break
+ # PERL5LIB
+ my @libs;
+ my @filtered_switches;
+ for (@switches) {
+ if ( !/$path_re/ && m/ ^ ['"]? -I ['"]? (.*?) ['"]? $ /x ) {
+ push @libs, $1;
+ }
+ else {
+ push @filtered_switches, $_;
+ }
+ }
+
+ return \@libs, \@filtered_switches;
+}
+
+sub _iterator_hooks {
+ my ( $class, $source, $libs, $switches ) = @_;
+
+ my $setup = sub {
+ if ( @{$libs} and !$class->_has_taint_switch($switches) ) {
+ $ENV{PERL5LIB} = join(
+ $Config{path_sep}, grep {defined} @{$libs},
+ $ENV{PERL5LIB}
+ );
+ }
+ };
+
+ # VMS environment variables aren't guaranteed to reset at the end of
+ # the process, so we need to put PERL5LIB back.
+ my $previous = $ENV{PERL5LIB};
+ my $teardown = sub {
+ if ( defined $previous ) {
+ $ENV{PERL5LIB} = $previous;
+ }
+ else {
+ delete $ENV{PERL5LIB};
+ }
+ };
+
+ return ( $setup, $teardown );
+}
+
+sub _run {
+ my ( $class, $source, $libs, $switches ) = @_;
+
+ my @command = $class->_get_command_for_switches( $source, $switches )
+ or $class->_croak("No command found!");
+
+ my ( $setup, $teardown ) = $class->_iterator_hooks( $source, $libs, $switches );
+
+ return $class->_create_iterator( $source, \@command, $setup, $teardown );
+}
+
+sub _create_iterator {
+ my ( $class, $source, $command, $setup, $teardown ) = @_;
+
+ return TAP::Parser::Iterator::Process->new(
+ { command => $command,
+ merge => $source->merge,
+ setup => $setup,
+ teardown => $teardown,
+ }
+ );
+}
+
+sub _get_command_for_switches {
+ my ( $class, $source, $switches ) = @_;
+ my $file = ${ $source->raw };
+ my @args = @{ $source->test_args || [] };
+ my $command = $class->get_perl;
+
+ # XXX don't need to quote if we treat the parts as atoms (except maybe vms)
+ #$file = qq["$file"] if ( $file =~ /\s/ ) && ( $file !~ /^".*"$/ );
+ my @command = ( $command, @{$switches}, $file, @args );
+ return @command;
+}
+
+sub _libs2switches {
+ my $class = shift;
+ return map {"-I$_"} grep {$_} @{ $_[0] };
+}
+
+=head3 C<get_taint>
+
+Decode any taint switches from a Perl shebang line.
+
+ # $taint will be 't'
+ my $taint = TAP::Parser::SourceHandler::Perl->get_taint( '#!/usr/bin/perl -t' );
+
+ # $untaint will be undefined
+ my $untaint = TAP::Parser::SourceHandler::Perl->get_taint( '#!/usr/bin/perl' );
+
+=cut
+
+sub get_taint {
+ my ( $class, $shebang ) = @_;
+ return
+ unless defined $shebang
+ && $shebang =~ /^#!.*\bperl.*\s-\w*([Tt]+)/;
+ return $1;
+}
+
+sub _switches {
+ my ( $class, $source ) = @_;
+ my $file = ${ $source->raw };
+ my @switches = @{ $source->switches || [] };
+ my $shebang = $source->meta->{file}->{shebang};
+ return unless defined $shebang;
+
+ my $taint = $class->get_taint($shebang);
+ push @switches, "-$taint" if defined $taint;
+
+ # Quote the argument if we're VMS, since VMS will downcase anything
+ # not quoted.
+ if (IS_VMS) {
+ for (@switches) {
+ $_ = qq["$_"];
+ }
+ }
+
+ return @switches;
+}
+
+=head3 C<get_perl>
+
+Gets the version of Perl currently running the test suite.
+
+=cut
+
+sub get_perl {
+ my $class = shift;
+ return $ENV{HARNESS_PERL} if defined $ENV{HARNESS_PERL};
+ return qq["$^X"] if IS_WIN32 && ( $^X =~ /[^\w\.\/\\]/ );
+ return $^X;
+}
+
+1;
+
+__END__
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head2 Example
+
+ package MyPerlSourceHandler;
+
+ use strict;
+
+ use TAP::Parser::SourceHandler::Perl;
+
+ use base 'TAP::Parser::SourceHandler::Perl';
+
+ # use the version of perl from the shebang line in the test file
+ sub get_perl {
+ my $self = shift;
+ if (my $shebang = $self->shebang( $self->{file} )) {
+ $shebang =~ /^#!(.*\bperl.*?)(?:(?:\s)|(?:$))/;
+ return $1 if $1;
+ }
+ return $self->SUPER::get_perl(@_);
+ }
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Handle>,
+L<TAP::Parser::SourceHandler::RawTAP>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/RawTAP.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/RawTAP.pm
new file mode 100755
index 0000000000..c861de2717
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/SourceHandler/RawTAP.pm
@@ -0,0 +1,130 @@
+package TAP::Parser::SourceHandler::RawTAP;
+
+use strict;
+use warnings;
+
+use TAP::Parser::IteratorFactory ();
+use TAP::Parser::Iterator::Array ();
+
+use base 'TAP::Parser::SourceHandler';
+
+TAP::Parser::IteratorFactory->register_handler(__PACKAGE__);
+
+=head1 NAME
+
+TAP::Parser::SourceHandler::RawTAP - Stream output from raw TAP in a scalar/array ref.
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::Source;
+ use TAP::Parser::SourceHandler::RawTAP;
+
+ my $source = TAP::Parser::Source->new->raw( \"1..1\nok 1\n" );
+ $source->assemble_meta;
+
+ my $class = 'TAP::Parser::SourceHandler::RawTAP';
+ my $vote = $class->can_handle( $source );
+ my $iter = $class->make_iterator( $source );
+
+=head1 DESCRIPTION
+
+This is a I<raw TAP output> L<TAP::Parser::SourceHandler> - it has 2 jobs:
+
+1. Figure out if the L<TAP::Parser::Source> it's given is raw TAP output
+(L</can_handle>).
+
+2. Creates an iterator for raw TAP output (L</make_iterator>).
+
+Unless you're writing a plugin or subclassing L<TAP::Parser>, you probably
+won't need to use this module directly.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<can_handle>
+
+ my $vote = $class->can_handle( $source );
+
+Only votes if $source is an array, or a scalar with newlines. Casts the
+following votes:
+
+ 0.9 if it's a scalar with '..' in it
+ 0.7 if it's a scalar with 'ok' in it
+ 0.3 if it's just a scalar with newlines
+ 0.5 if it's an array
+
+=cut
+
+sub can_handle {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+
+ return 0 if $meta->{file};
+ if ( $meta->{is_scalar} ) {
+ return 0 unless $meta->{has_newlines};
+ return 0.9 if ${ $src->raw } =~ /\d\.\.\d/;
+ return 0.7 if ${ $src->raw } =~ /ok/;
+ return 0.3;
+ }
+ elsif ( $meta->{is_array} ) {
+ return 0.5;
+ }
+ return 0;
+}
+
+=head3 C<make_iterator>
+
+ my $iterator = $class->make_iterator( $source );
+
+Returns a new L<TAP::Parser::Iterator::Array> for the source.
+C<$source-E<gt>raw> must be an array ref, or a scalar ref.
+
+C<croak>s on error.
+
+=cut
+
+sub make_iterator {
+ my ( $class, $src ) = @_;
+ my $meta = $src->meta;
+
+ my $tap_array;
+ if ( $meta->{is_scalar} ) {
+ $tap_array = [ split "\n" => ${ $src->raw } ];
+ }
+ elsif ( $meta->{is_array} ) {
+ $tap_array = $src->raw;
+ }
+
+ $class->_croak('No raw TAP found in $source->raw')
+ unless scalar $tap_array;
+
+ return TAP::Parser::Iterator::Array->new($tap_array);
+}
+
+1;
+
+=head1 SUBCLASSING
+
+Please see L<TAP::Parser/SUBCLASSING> for a subclassing overview.
+
+=head1 SEE ALSO
+
+L<TAP::Object>,
+L<TAP::Parser>,
+L<TAP::Parser::IteratorFactory>,
+L<TAP::Parser::SourceHandler>,
+L<TAP::Parser::SourceHandler::Executable>,
+L<TAP::Parser::SourceHandler::Perl>,
+L<TAP::Parser::SourceHandler::File>,
+L<TAP::Parser::SourceHandler::Handle>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Reader.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Reader.pm
new file mode 100755
index 0000000000..0250ad2983
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Reader.pm
@@ -0,0 +1,347 @@
+package TAP::Parser::YAMLish::Reader;
+
+use strict;
+use warnings;
+
+use base 'TAP::Object';
+
+our $VERSION = '3.48';
+
+ # No EBCDIC support on early perls
+*to_native = (ord "A" == 65 || $] < 5.008)
+ ? sub { return shift }
+ : sub { utf8::unicode_to_native(shift) };
+
+# TODO:
+# Handle blessed object syntax
+
+# Printable characters for escapes
+my %UNESCAPES = (
+ z => "\x00", a => "\a", t => "\t",
+ n => "\n", v => "\cK", f => "\f",
+ r => "\r", e => "\e", '\\' => '\\',
+);
+
+my $QQ_STRING = qr{ " (?:\\. | [^"])* " }x;
+my $HASH_LINE = qr{ ^ ($QQ_STRING|\S+) \s* : \s* (?: (.+?) \s* )? $ }x;
+my $IS_HASH_KEY = qr{ ^ [\w\'\"] }x;
+my $IS_END_YAML = qr{ ^ \.\.\. \s* $ }x;
+my $IS_QQ_STRING = qr{ ^ $QQ_STRING $ }x;
+my $IS_ARRAY_LINE = qr{ ^ - \s* ($QQ_STRING|\S+) }x;
+
+# new() implementation supplied by TAP::Object
+
+sub read {
+ my $self = shift;
+ my $obj = shift;
+
+ die "Must have a code reference to read input from"
+ unless ref $obj eq 'CODE';
+
+ $self->{reader} = $obj;
+ $self->{capture} = [];
+
+ # Prime the reader
+ $self->_next;
+ return unless $self->{next};
+
+ my $doc = $self->_read;
+
+ # The terminator is mandatory otherwise we'd consume a line from the
+ # iterator that doesn't belong to us. If we want to remove this
+ # restriction we'll have to implement look-ahead in the iterators.
+ # Which might not be a bad idea.
+ my $dots = $self->_peek;
+ die "Missing '...' at end of YAMLish"
+ unless defined $dots
+ and $dots =~ $IS_END_YAML;
+
+ delete $self->{reader};
+ delete $self->{next};
+
+ return $doc;
+}
+
+sub get_raw { join( "\n", grep defined, @{ shift->{capture} || [] } ) . "\n" }
+
+sub _peek {
+ my $self = shift;
+ return $self->{next} unless wantarray;
+ my $line = $self->{next};
+ $line =~ /^ (\s*) (.*) $ /x;
+ return ( $2, length $1 );
+}
+
+sub _next {
+ my $self = shift;
+ die "_next called with no reader"
+ unless $self->{reader};
+ my $line = $self->{reader}->();
+ $self->{next} = $line;
+ push @{ $self->{capture} }, $line;
+}
+
+sub _read {
+ my $self = shift;
+
+ my $line = $self->_peek;
+
+ # Do we have a document header?
+ if ( $line =~ /^ --- (?: \s* (.+?)? \s* )? $/x ) {
+ $self->_next;
+
+ return $self->_read_scalar($1) if defined $1; # Inline?
+
+ my ( $next, $indent ) = $self->_peek;
+
+ if ( $next =~ /^ - /x ) {
+ return $self->_read_array($indent);
+ }
+ elsif ( $next =~ $IS_HASH_KEY ) {
+ return $self->_read_hash( $next, $indent );
+ }
+ elsif ( $next =~ $IS_END_YAML ) {
+ die "Premature end of YAMLish";
+ }
+ else {
+ die "Unsupported YAMLish syntax: '$next'";
+ }
+ }
+ else {
+ die "YAMLish document header not found";
+ }
+}
+
+# Parse a double quoted string
+sub _read_qq {
+ my $self = shift;
+ my $str = shift;
+
+ unless ( $str =~ s/^ " (.*?) " $/$1/x ) {
+ die "Internal: not a quoted string";
+ }
+
+ $str =~ s/\\"/"/gx;
+ $str =~ s/ \\ ( [tartan\\favez] | x([0-9a-fA-F]{2}) )
+ / (length($1) > 1) ? pack("H2", to_native($2))
+ : $UNESCAPES{$1} /gex;
+ return $str;
+}
+
+# Parse a scalar string to the actual scalar
+sub _read_scalar {
+ my $self = shift;
+ my $string = shift;
+
+ return undef if $string eq '~';
+ return {} if $string eq '{}';
+ return [] if $string eq '[]';
+
+ if ( $string eq '>' || $string eq '|' ) {
+
+ my ( $line, $indent ) = $self->_peek;
+ die "Multi-line scalar content missing" unless defined $line;
+
+ my @multiline = ($line);
+
+ while (1) {
+ $self->_next;
+ my ( $next, $ind ) = $self->_peek;
+ last if $ind < $indent;
+
+ my $pad = $string eq '|' ? ( ' ' x ( $ind - $indent ) ) : '';
+ push @multiline, $pad . $next;
+ }
+
+ return join( ( $string eq '>' ? ' ' : "\n" ), @multiline ) . "\n";
+ }
+
+ if ( $string =~ /^ ' (.*) ' $/x ) {
+ ( my $rv = $1 ) =~ s/''/'/g;
+ return $rv;
+ }
+
+ if ( $string =~ $IS_QQ_STRING ) {
+ return $self->_read_qq($string);
+ }
+
+ if ( $string =~ /^['"]/ ) {
+
+ # A quote with folding... we don't support that
+ die __PACKAGE__ . " does not support multi-line quoted scalars";
+ }
+
+ # Regular unquoted string
+ return $string;
+}
+
+sub _read_nested {
+ my $self = shift;
+
+ my ( $line, $indent ) = $self->_peek;
+
+ if ( $line =~ /^ -/x ) {
+ return $self->_read_array($indent);
+ }
+ elsif ( $line =~ $IS_HASH_KEY ) {
+ return $self->_read_hash( $line, $indent );
+ }
+ else {
+ die "Unsupported YAMLish syntax: '$line'";
+ }
+}
+
+# Parse an array
+sub _read_array {
+ my ( $self, $limit ) = @_;
+
+ my $ar = [];
+
+ while (1) {
+ my ( $line, $indent ) = $self->_peek;
+ last
+ if $indent < $limit
+ || !defined $line
+ || $line =~ $IS_END_YAML;
+
+ if ( $indent > $limit ) {
+ die "Array line over-indented";
+ }
+
+ if ( $line =~ /^ (- \s+) \S+ \s* : (?: \s+ | $ ) /x ) {
+ $indent += length $1;
+ $line =~ s/-\s+//;
+ push @$ar, $self->_read_hash( $line, $indent );
+ }
+ elsif ( $line =~ /^ - \s* (.+?) \s* $/x ) {
+ die "Unexpected start of YAMLish" if $line =~ /^---/;
+ $self->_next;
+ push @$ar, $self->_read_scalar($1);
+ }
+ elsif ( $line =~ /^ - \s* $/x ) {
+ $self->_next;
+ push @$ar, $self->_read_nested;
+ }
+ elsif ( $line =~ $IS_HASH_KEY ) {
+ $self->_next;
+ push @$ar, $self->_read_hash( $line, $indent, );
+ }
+ else {
+ die "Unsupported YAMLish syntax: '$line'";
+ }
+ }
+
+ return $ar;
+}
+
+sub _read_hash {
+ my ( $self, $line, $limit ) = @_;
+
+ my $indent;
+ my $hash = {};
+
+ while (1) {
+ die "Badly formed hash line: '$line'"
+ unless $line =~ $HASH_LINE;
+
+ my ( $key, $value ) = ( $self->_read_scalar($1), $2 );
+ $self->_next;
+
+ my ( $next_line, $next_indent ) = $self->_peek;
+
+ if ( defined $value ) {
+ $hash->{$key} = $self->_read_scalar($value);
+ }
+ elsif (not defined $value # no explicit undef ("~") given
+ and $next_indent <= $limit # next line is same or less indentation
+ and $next_line !~ $IS_ARRAY_LINE) # arrays can start at same indent
+ {
+ $hash->{$key} = undef;
+ }
+ else {
+ $hash->{$key} = $self->_read_nested;
+ }
+
+ ( $line, $indent ) = $self->_peek;
+ last
+ if $indent < $limit
+ || !defined $line
+ || $line =~ $IS_END_YAML;
+ }
+
+ return $hash;
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator
+
+=head1 VERSION
+
+Version 3.48
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+Note that parts of this code were derived from L<YAML::Tiny> with the
+permission of Adam Kennedy.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+The constructor C<new> creates and returns an empty
+C<TAP::Parser::YAMLish::Reader> object.
+
+ my $reader = TAP::Parser::YAMLish::Reader->new;
+
+=head2 Instance Methods
+
+=head3 C<read>
+
+ my $got = $reader->read($iterator);
+
+Read YAMLish from a L<TAP::Parser::Iterator> and return the data structure it
+represents.
+
+=head3 C<get_raw>
+
+ my $source = $reader->get_source;
+
+Return the raw YAMLish source from the most recent C<read>.
+
+=head1 AUTHOR
+
+Andy Armstrong, <andy@hexten.net>
+
+Adam Kennedy wrote L<YAML::Tiny> which provided the template and many of
+the YAML matching regular expressions for this module.
+
+=head1 SEE ALSO
+
+L<YAML::Tiny>, L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,
+L<http://use.perl.org/~Alias/journal/29427>
+
+=head1 COPYRIGHT
+
+Copyright 2007-2011 Andy Armstrong.
+
+Portions copyright 2006-2008 Adam Kennedy.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Writer.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Writer.pm
new file mode 100755
index 0000000000..a11a02a285
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/TAP/Parser/YAMLish/Writer.pm
@@ -0,0 +1,263 @@
+package TAP::Parser::YAMLish::Writer;
+
+use strict;
+use warnings;
+
+use base 'TAP::Object';
+
+our $VERSION = '3.48';
+
+ # No EBCDIC support on early perls
+*from_native = (ord "A" == 65 || $] < 5.008)
+ ? sub { return shift }
+ : sub { utf8::native_to_unicode(shift) };
+
+my $ESCAPE_CHAR = qr{ [ [:cntrl:] \" ] }x;
+my $ESCAPE_KEY = qr{ (?: ^\W ) | $ESCAPE_CHAR }x;
+
+my @UNPRINTABLE;
+$UNPRINTABLE[$_] = sprintf("x%02x", from_native($_)) for 0 .. ord(" ") - 1;
+$UNPRINTABLE[ord "\0"] = 'z';
+$UNPRINTABLE[ord "\a"] = 'a';
+$UNPRINTABLE[ord "\t"] = 't';
+$UNPRINTABLE[ord "\n"] = 'n';
+$UNPRINTABLE[ord "\cK"] = 'v';
+$UNPRINTABLE[ord "\f"] = 'f';
+$UNPRINTABLE[ord "\r"] = 'r';
+$UNPRINTABLE[ord "\e"] = 'e';
+
+# new() implementation supplied by TAP::Object
+
+sub write {
+ my $self = shift;
+
+ die "Need something to write"
+ unless @_;
+
+ my $obj = shift;
+ my $out = shift || \*STDOUT;
+
+ die "Need a reference to something I can write to"
+ unless ref $out;
+
+ $self->{writer} = $self->_make_writer($out);
+
+ $self->_write_obj( '---', $obj );
+ $self->_put('...');
+
+ delete $self->{writer};
+}
+
+sub _make_writer {
+ my $self = shift;
+ my $out = shift;
+
+ my $ref = ref $out;
+
+ if ( 'CODE' eq $ref ) {
+ return $out;
+ }
+ elsif ( 'ARRAY' eq $ref ) {
+ return sub { push @$out, shift };
+ }
+ elsif ( 'SCALAR' eq $ref ) {
+ return sub { $$out .= shift() . "\n" };
+ }
+ elsif ( 'GLOB' eq $ref || 'IO::Handle' eq $ref ) {
+ return sub { print $out shift(), "\n" };
+ }
+
+ die "Can't write to $out";
+}
+
+sub _put {
+ my $self = shift;
+ $self->{writer}->( join '', @_ );
+}
+
+sub _enc_scalar {
+ my $self = shift;
+ my $val = shift;
+ my $rule = shift;
+
+ return '~' unless defined $val;
+
+ if ( $val =~ /$rule/ ) {
+ $val =~ s/\\/\\\\/g;
+ $val =~ s/"/\\"/g;
+ $val =~ s/ ( [[:cntrl:]] ) / '\\' . $UNPRINTABLE[ ord($1) ] /gex;
+ return qq{"$val"};
+ }
+
+ if ( length($val) == 0 or $val =~ /\s/ ) {
+ $val =~ s/'/''/;
+ return "'$val'";
+ }
+
+ return $val;
+}
+
+sub _write_obj {
+ my $self = shift;
+ my $prefix = shift;
+ my $obj = shift;
+ my $indent = shift || 0;
+
+ if ( my $ref = ref $obj ) {
+ my $pad = ' ' x $indent;
+ if ( 'HASH' eq $ref ) {
+ if ( keys %$obj ) {
+ $self->_put($prefix);
+ for my $key ( sort keys %$obj ) {
+ my $value = $obj->{$key};
+ $self->_write_obj(
+ $pad . $self->_enc_scalar( $key, $ESCAPE_KEY ) . ':',
+ $value, $indent + 1
+ );
+ }
+ }
+ else {
+ $self->_put( $prefix, ' {}' );
+ }
+ }
+ elsif ( 'ARRAY' eq $ref ) {
+ if (@$obj) {
+ $self->_put($prefix);
+ for my $value (@$obj) {
+ $self->_write_obj(
+ $pad . '-', $value,
+ $indent + 1
+ );
+ }
+ }
+ else {
+ $self->_put( $prefix, ' []' );
+ }
+ }
+ else {
+ die "Don't know how to encode $ref";
+ }
+ }
+ else {
+ $self->_put( $prefix, ' ', $self->_enc_scalar( $obj, $ESCAPE_CHAR ) );
+ }
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+TAP::Parser::YAMLish::Writer - Write YAMLish data
+
+=head1 VERSION
+
+Version 3.48
+
+=head1 SYNOPSIS
+
+ use TAP::Parser::YAMLish::Writer;
+
+ my $data = {
+ one => 1,
+ two => 2,
+ three => [ 1, 2, 3 ],
+ };
+
+ my $yw = TAP::Parser::YAMLish::Writer->new;
+
+ # Write to an array...
+ $yw->write( $data, \@some_array );
+
+ # ...an open file handle...
+ $yw->write( $data, $some_file_handle );
+
+ # ...a string ...
+ $yw->write( $data, \$some_string );
+
+ # ...or a closure
+ $yw->write( $data, sub {
+ my $line = shift;
+ print "$line\n";
+ } );
+
+=head1 DESCRIPTION
+
+Encodes a scalar, hash reference or array reference as YAMLish.
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+ my $writer = TAP::Parser::YAMLish::Writer->new;
+
+The constructor C<new> creates and returns an empty
+C<TAP::Parser::YAMLish::Writer> object.
+
+=head2 Instance Methods
+
+=head3 C<write>
+
+ $writer->write($obj, $output );
+
+Encode a scalar, hash reference or array reference as YAML.
+
+ my $writer = sub {
+ my $line = shift;
+ print SOMEFILE "$line\n";
+ };
+
+ my $data = {
+ one => 1,
+ two => 2,
+ three => [ 1, 2, 3 ],
+ };
+
+ my $yw = TAP::Parser::YAMLish::Writer->new;
+ $yw->write( $data, $writer );
+
+
+The C< $output > argument may be:
+
+=over
+
+=item * a reference to a scalar to append YAML to
+
+=item * the handle of an open file
+
+=item * a reference to an array into which YAML will be pushed
+
+=item * a code reference
+
+=back
+
+If you supply a code reference the subroutine will be called once for
+each line of output with the line as its only argument. Passed lines
+will have no trailing newline.
+
+=head1 AUTHOR
+
+Andy Armstrong, <andy@hexten.net>
+
+=head1 SEE ALSO
+
+L<YAML::Tiny>, L<YAML>, L<YAML::Syck>, L<Config::Tiny>, L<CSS::Tiny>,
+L<http://use.perl.org/~Alias/journal/29427>
+
+=head1 COPYRIGHT
+
+Copyright 2007-2011 Andy Armstrong.
+
+This program is free software; you can redistribute
+it and/or modify it under the same terms as Perl itself.
+
+The full text of the license can be found in the
+LICENSE file included with this module.
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm
index 4fd0e2f361..2d90b3a6ee 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm
@@ -2,7 +2,7 @@ use strict;
use warnings;
package Test::Fatal;
# ABSTRACT: incredibly simple helpers for testing code with exceptions
-$Test::Fatal::VERSION = '0.016';
+$Test::Fatal::VERSION = '0.017';
#pod =head1 SYNOPSIS
#pod
#pod use Test::More;
@@ -105,7 +105,7 @@ our @EXPORT_OK = qw(exception success dies_ok lives_ok);
#pod exception_like(sub { }, [ qr/foo/, 'foo appears in the exception' ] );
#pod
#pod To aid in avoiding the problem where the pattern is seen in the exception
-#pod because of the call stack, C<$Carp::MAxArgNums> is locally set to -1 when the
+#pod because of the call stack, C<$Carp::MaxArgNums> is locally set to -1 when the
#pod code block is called. If you really don't want that, set it back to whatever
#pod value you like at the beginning of the code block. Obviously, this solution
#pod doens't affect all possible ways that args of subroutines in the call stack
@@ -197,7 +197,7 @@ sub success (&;@) {
#pod =func lives_ok
#pod
#pod Exported only by request, these two functions run a given block of code, and
-#pod provide TAP output indicating if it did, or did not throw an exception.
+#pod provide TAP output indicating if it did, or did not throw an exception.
#pod These provide an easy upgrade path for replacing existing unit tests based on
#pod C<Test::Exception>.
#pod
@@ -270,7 +270,7 @@ Test::Fatal - incredibly simple helpers for testing code with exceptions
=head1 VERSION
-version 0.016
+version 0.017
=head1 SYNOPSIS
@@ -311,6 +311,16 @@ false positives if exceptions use stack traces that show arguments. For a more
magical approach involving globally overriding C<caller>, see
L<Test::Exception>.
+=head1 PERL VERSION
+
+This library should run on perls released even a long time ago. It should work
+on any version of perl released in the last five years.
+
+Although it may work on older versions of perl, no guarantee is made that the
+minimum required version will not be increased. The version may be increased
+for any reason, and there is no promise that patches will be accepted to lower
+the minimum required perl.
+
=head1 FUNCTIONS
=head2 exception
@@ -366,7 +376,7 @@ arguments in an array reference to hide the literal text from a stack trace:
exception_like(sub { }, [ qr/foo/, 'foo appears in the exception' ] );
To aid in avoiding the problem where the pattern is seen in the exception
-because of the call stack, C<$Carp::MAxArgNums> is locally set to -1 when the
+because of the call stack, C<$Carp::MaxArgNums> is locally set to -1 when the
code block is called. If you really don't want that, set it back to whatever
value you like at the beginning of the code block. Obviously, this solution
doens't affect all possible ways that args of subroutines in the call stack
@@ -407,7 +417,7 @@ success blocks may sometimes help organize complex testing.
=head2 lives_ok
Exported only by request, these two functions run a given block of code, and
-provide TAP output indicating if it did, or did not throw an exception.
+provide TAP output indicating if it did, or did not throw an exception.
These provide an easy upgrade path for replacing existing unit tests based on
C<Test::Exception>.
@@ -423,11 +433,11 @@ use Test::Fatal's C<exception> routine.
=head1 AUTHOR
-Ricardo Signes <rjbs@cpan.org>
+Ricardo Signes <cpan@semiotic.systems>
=head1 CONTRIBUTORS
-=for stopwords David Golden Graham Knop Jesse Luehrs Joel Bernstein Karen Etheridge
+=for stopwords David Golden Graham Knop Jesse Luehrs Joel Bernstein Karen Etheridge Ricardo Signes
=over 4
@@ -451,6 +461,10 @@ Joel Bernstein <joel@fysh.org>
Karen Etheridge <ether@cpan.org>
+=item *
+
+Ricardo Signes <rjbs@semiotic.systems>
+
=back
=head1 COPYRIGHT AND LICENSE
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/HACKING.pod b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/HACKING.pod
new file mode 100755
index 0000000000..91b33011a0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/HACKING.pod
@@ -0,0 +1,264 @@
+
+# this is in pod format (try `perldoc HACKING.pod`)
+
+=pod
+
+=head1 NAME
+
+HACKING.pod - contributing to TAP::Harness
+
+=head1 ABOUT
+
+This is the guide for TAP::Harness internals contributors (developers,
+testers, documenters.)
+
+If you are looking for more information on how to I<use> TAP::Harness,
+you probably want
+L<http://testanything.org/testing-with-tap/perl/tap-parser-cookbook.html>
+instead.
+
+=head1 Getting Started
+
+See the resources section in I<META.yml> or I<Build.PL> for links to the
+project mailing list, bug tracker, svn repository, etc.
+
+For ease of reference, at the time of writing the SVN repository was at:
+
+ http://svn.hexten.net/tapx
+
+To get the latest version of trunk:
+
+ git clone git://github.com/Perl-Toolchain-Gang/Test-Harness.git
+
+For best results, read the rest of this file, check RT for bugs which
+scratch your itch, join the mailing list, etc.
+
+=head1 Formatting
+
+=head2 perltidy
+
+The project comes with a C<.perltidyrc>, which perltidy will
+automatically use if the project root is your working directory. This
+is setup by default to read and write the perl code on a pipe. To
+configure your editor:
+
+=over 4
+
+=item * vim
+
+In C<.vimrc>, you can add the following lines:
+
+ nnoremap <Leader>pt :%!perltidy -q<cr> " only work in 'normal' mode
+ vnoremap <Leader>pt :!perltidy -q<cr> " only work in 'visual' mode
+
+In other words, if your C<Leader> is a backslash, you can type C<\pt> to
+reformat the file using the C<.perltidyrc>. If you are in visual mode
+(selecting lines with shift-v), then only the code you have currently have
+selected will be reformatted.
+
+=item * emacs
+
+For emacs, you can use this snippet from Sam Tregar
+(L<http://use.perl.org/~samtregar/journal/30185>):
+
+ (defun perltidy-region ()
+ "Run perltidy on the current region."
+ (interactive)
+ (save-excursion
+ (shell-command-on-region (point) (mark) "perltidy -q" nil t)
+ (cperl-mode)))
+
+ (defun perltidy-all ()
+ "Run perltidy on the current region."
+ (interactive)
+ (let ((p (point)))
+ (save-excursion
+ (shell-command-on-region (point-min) (point-max) "perltidy -q" nil t)
+ )
+ (goto-char p)
+ (cperl-mode)))
+
+ (global-set-key "\M-t" `perltidy-region)
+ (global-set-key "\M-T" `perltidy-all)
+
+=back
+
+=head1 Tests and Coverage
+
+...
+
+=for eric_not_it
+ TODO link to a good guide on writing tests for TAP::Parser
+
+=head1 Writing for Compatibility
+
+...
+
+=for eric_not_it
+ TODO explain no bundling, PERL_CORE, etc
+
+=head1 Use TAP::Object
+
+TAP::Object is the common base class to all TAP::* modules, and should be for
+any that you write.
+
+=head1 Exception Handling
+
+Exceptions should be raised with L<Carp>:
+
+ require Carp;
+ Carp::croak("Unsupported syntax version: $version");
+
+ require Carp;
+ Carp::confess("Unsupported syntax version: $version");
+
+=head1 Deprecation cycle
+
+Any I<documented> sub that needs to be changed or removed (and would therefore
+cause a backwards-compat issue) must go through a deprecation cycle to give
+developers a chance to adjust:
+
+ 1. Document the deprecation
+ 2. Carp a suitable message
+ 3. Release
+ 4. Change the code
+ 5. Release
+
+=head1 Documentation
+
+The end-user and API documentation is all in the 'lib/' directory. In
+.pm files, the pod is "inline" to the code. See L<perlpod> for more
+about pod.
+
+=head2 Pod Commands
+
+For compatibility's sake, we do not use the =head3 and =head4 commands.
+
+=over
+
+=item C<=head1 SECTION>
+
+Sections begin with an C<=head1> command and are all-caps.
+
+=for eric_not_it
+ I guess... Mixed case messes with various pod hacking tools.
+
+ NAME
+ VERSION
+ SYNOPSIS
+ CONSTRUCTOR
+ METHODS
+ CLASS METHODS
+ SOME OTHER SORT OF METHODS
+ SEE ALSO
+
+=item C<=head2 method>
+
+=for eric_not_it
+ The following is how I would do it, but opposite of what we have.
+
+The C<=head2> command documents a method. The name of the method should have no adornment (e.g. don't CE<lt>method> or CE<lt>method($list, $of, $params)>.)
+
+These sections should begin with a short description of what the method
+does, followed by one or more examples of usage. If needed, elaborate
+on the subtleties of the parameters and context after (and/or between)
+the example(s).
+
+ =head2 this_method
+
+ This method does some blah blah blah.
+
+ my @answer = $thing->this_method(@arguments);
+
+ =head2 that_thing
+
+ Returns true if the thing is true.
+
+ if($thing->that_thing) {
+ ...
+ }
+
+=item C<=item parameter>
+
+Use C<=item> commands for method arguments and parameters (and etc.) In
+most html pod formatters, these I<do not> get added to the
+table-of-contents at the top of the page.
+
+=back
+
+=head2 Pod Formatting Codes
+
+=over
+
+=item LE<lt>Some::Module>
+
+Be careful of the wording of C<LE<lt>Some::ModuleE<gt>>. Older pod
+formatters would render this as "the Some::Module manpage", so it is
+best to either word your links as "C<(see E<lt>Some::ModuleE<gt> for
+details.)>" or use the "explicit rendering" form of
+"C<E<lt>Some::Module|Some::ModuleE<gt>>".
+
+=back
+
+=head2 VERSION
+
+The version numbers are updated by L<Perl::Version>.
+
+=head2 DEVELOPER DOCS/NOTES
+
+The following "formats" are used with C<=begin>/C<=end> and C<=for>
+commands for pod which is not part of the public end-user/API
+documentation.
+
+=over
+
+=item note
+
+Use this if you are uncertain about a change to some pod or think it
+needs work.
+
+ =head2 some_method
+
+ ...
+
+ =for note
+ This is either falsely documented or a bug -- see ...
+
+=item developer
+
+ =begin developer
+
+ Long-winded explanation of why some code is the way it is or various
+ other subtleties which might incite head-scratching and WTF'ing.
+
+ =end developer
+
+=item deprecated
+
+ =for deprecated
+ removed in 0.09, kill by ~0.25
+
+=back
+
+=head1 Committing to Subversion
+
+If you have commit access, please bear this in mind.
+
+Development is done either on trunk or a branch, as appropriate:
+
+If it's something that might be controversial, break the build or take a long
+time (more than a couple of weeks) to complete then it'd probably be
+appropriate to branch. Otherwise it can go in trunk.
+
+If in doubt discuss it on the mailing list before you commit.
+
+=cut
+
+=for developer
+... or whatever. I'm just making stuff up here. If any of this is
+wrong, please correct it. To the extent that there is an "official
+policy", it should be written down. --Eric
+
+=cut
+
+# vim:ts=2:sw=2:et:sta
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Harness.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Harness.pm
new file mode 100755
index 0000000000..33e57fcc84
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Harness.pm
@@ -0,0 +1,618 @@
+package Test::Harness;
+
+use 5.006;
+
+use strict;
+use warnings;
+
+use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
+use constant IS_VMS => ( $^O eq 'VMS' );
+
+use TAP::Harness ();
+use TAP::Parser::Aggregator ();
+use TAP::Parser::Source ();
+use TAP::Parser::SourceHandler::Perl ();
+
+use Text::ParseWords qw(shellwords);
+
+use Config;
+use base 'Exporter';
+
+# $ML $Last_ML_Print
+
+BEGIN {
+ eval q{use Time::HiRes 'time'};
+ our $has_time_hires = !$@;
+}
+
+=head1 NAME
+
+Test::Harness - Run Perl standard test scripts with statistics
+
+=head1 VERSION
+
+Version 3.48
+
+=cut
+
+our $VERSION = '3.48';
+
+# Backwards compatibility for exportable variable names.
+*verbose = *Verbose;
+*switches = *Switches;
+*debug = *Debug;
+
+$ENV{HARNESS_ACTIVE} = 1;
+$ENV{HARNESS_VERSION} = $VERSION;
+
+END {
+
+ # For VMS.
+ delete $ENV{HARNESS_ACTIVE};
+ delete $ENV{HARNESS_VERSION};
+}
+
+our @EXPORT = qw(&runtests);
+our @EXPORT_OK = qw(&execute_tests $verbose $switches);
+
+our $Verbose = $ENV{HARNESS_VERBOSE} || 0;
+our $Debug = $ENV{HARNESS_DEBUG} || 0;
+our $Switches = '-w';
+our $Columns = $ENV{HARNESS_COLUMNS} || $ENV{COLUMNS} || 80;
+$Columns--; # Some shells have trouble with a full line of text.
+our $Timer = $ENV{HARNESS_TIMER} || 0;
+our $Color = $ENV{HARNESS_COLOR} || 0;
+our $IgnoreExit = $ENV{HARNESS_IGNORE_EXIT} || 0;
+
+=head1 SYNOPSIS
+
+ use Test::Harness;
+
+ runtests(@test_files);
+
+=head1 DESCRIPTION
+
+Although, for historical reasons, the L<Test::Harness> distribution
+takes its name from this module it now exists only to provide
+L<TAP::Harness> with an interface that is somewhat backwards compatible
+with L<Test::Harness> 2.xx. If you're writing new code consider using
+L<TAP::Harness> directly instead.
+
+Emulation is provided for C<runtests> and C<execute_tests> but the
+pluggable 'Straps' interface that previous versions of L<Test::Harness>
+supported is not reproduced here. Straps is now available as a stand
+alone module: L<Test::Harness::Straps>.
+
+See L<TAP::Parser>, L<TAP::Harness> for the main documentation for this
+distribution.
+
+=head1 FUNCTIONS
+
+The following functions are available.
+
+=head2 runtests( @test_files )
+
+This runs all the given I<@test_files> and divines whether they passed
+or failed based on their output to STDOUT (details above). It prints
+out each individual test which failed along with a summary report and
+a how long it all took.
+
+It returns true if everything was ok. Otherwise it will C<die()> with
+one of the messages in the DIAGNOSTICS section.
+
+=cut
+
+sub _has_taint {
+ my $test = shift;
+ return TAP::Parser::SourceHandler::Perl->get_taint(
+ TAP::Parser::Source->shebang($test) );
+}
+
+sub _aggregate {
+ my ( $harness, $aggregate, @tests ) = @_;
+
+ # Don't propagate to our children
+ local $ENV{HARNESS_OPTIONS};
+
+ _apply_extra_INC($harness);
+ _aggregate_tests( $harness, $aggregate, @tests );
+}
+
+# Make sure the child sees all the extra junk in @INC
+sub _apply_extra_INC {
+ my $harness = shift;
+
+ $harness->callback(
+ parser_args => sub {
+ my ( $args, $test ) = @_;
+ push @{ $args->{switches} }, map {"-I$_"} _filtered_inc();
+ }
+ );
+}
+
+sub _aggregate_tests {
+ my ( $harness, $aggregate, @tests ) = @_;
+ $aggregate->start();
+ $harness->aggregate_tests( $aggregate, @tests );
+ $aggregate->stop();
+
+}
+
+sub runtests {
+ my @tests = @_;
+
+ # shield against -l
+ local ( $\, $, );
+
+ my $harness = _new_harness();
+ my $aggregate = TAP::Parser::Aggregator->new();
+
+ local $ENV{PERL_USE_UNSAFE_INC} = 1 if not exists $ENV{PERL_USE_UNSAFE_INC};
+ _aggregate( $harness, $aggregate, @tests );
+
+ $harness->formatter->summary($aggregate);
+
+ my $total = $aggregate->total;
+ my $passed = $aggregate->passed;
+ my $failed = $aggregate->failed;
+
+ my @parsers = $aggregate->parsers;
+
+ my $num_bad = 0;
+ for my $parser (@parsers) {
+ $num_bad++ if $parser->has_problems;
+ }
+
+ die(sprintf(
+ "Failed %d/%d test programs. %d/%d subtests failed.\n",
+ $num_bad, scalar @parsers, $failed, $total
+ )
+ ) if $num_bad;
+
+ return $total && $total == $passed;
+}
+
+sub _canon {
+ my @list = sort { $a <=> $b } @_;
+ my @ranges = ();
+ my $count = scalar @list;
+ my $pos = 0;
+
+ while ( $pos < $count ) {
+ my $end = $pos + 1;
+ $end++ while $end < $count && $list[$end] <= $list[ $end - 1 ] + 1;
+ push @ranges, ( $end == $pos + 1 )
+ ? $list[$pos]
+ : join( '-', $list[$pos], $list[ $end - 1 ] );
+ $pos = $end;
+ }
+
+ return join( ' ', @ranges );
+}
+
+sub _new_harness {
+ my $sub_args = shift || {};
+
+ my ( @lib, @switches );
+ my @opt = map { shellwords($_) } grep { defined } $Switches, $ENV{HARNESS_PERL_SWITCHES};
+ while ( my $opt = shift @opt ) {
+ if ( $opt =~ /^ -I (.*) $ /x ) {
+ push @lib, length($1) ? $1 : shift @opt;
+ }
+ else {
+ push @switches, $opt;
+ }
+ }
+
+ # Do things the old way on VMS...
+ push @lib, _filtered_inc() if IS_VMS;
+
+ # If $Verbose isn't numeric default to 1. This helps core.
+ my $verbosity = ( $Verbose ? ( $Verbose !~ /\d/ ) ? 1 : $Verbose : 0 );
+
+ my $args = {
+ timer => $Timer,
+ directives => our $Directives,
+ lib => \@lib,
+ switches => \@switches,
+ color => $Color,
+ verbosity => $verbosity,
+ ignore_exit => $IgnoreExit,
+ };
+
+ $args->{stdout} = $sub_args->{out}
+ if exists $sub_args->{out};
+
+ my $class = $ENV{HARNESS_SUBCLASS} || 'TAP::Harness';
+ if ( defined( my $env_opt = $ENV{HARNESS_OPTIONS} ) ) {
+ for my $opt ( split /:/, $env_opt ) {
+ if ( $opt =~ /^j(\d*)$/ ) {
+ $args->{jobs} = $1 || 9;
+ }
+ elsif ( $opt eq 'c' ) {
+ $args->{color} = 1;
+ }
+ elsif ( $opt =~ m/^f(.*)$/ ) {
+ my $fmt = $1;
+ $fmt =~ s/-/::/g;
+ $args->{formatter_class} = $fmt;
+ }
+ elsif ( $opt =~ m/^a(.*)$/ ) {
+ my $archive = $1;
+ $class = "TAP::Harness::Archive";
+ $args->{archive} = $archive;
+ }
+ else {
+ die "Unknown HARNESS_OPTIONS item: $opt\n";
+ }
+ }
+ }
+
+ return TAP::Harness->_construct( $class, $args );
+}
+
+# Get the parts of @INC which are changed from the stock list AND
+# preserve reordering of stock directories.
+sub _filtered_inc {
+ my @inc = grep { !ref } @INC; #28567
+
+ if (IS_VMS) {
+
+ # VMS has a 255-byte limit on the length of %ENV entries, so
+ # toss the ones that involve perl_root, the install location
+ @inc = grep !/perl_root/i, @inc;
+
+ }
+ elsif (IS_WIN32) {
+
+ # Lose any trailing backslashes in the Win32 paths
+ s/[\\\/]+$// for @inc;
+ }
+
+ my @default_inc = _default_inc();
+
+ my @new_inc;
+ my %seen;
+ for my $dir (@inc) {
+ next if $seen{$dir}++;
+
+ if ( $dir eq ( $default_inc[0] || '' ) ) {
+ shift @default_inc;
+ }
+ else {
+ push @new_inc, $dir;
+ }
+
+ shift @default_inc while @default_inc and $seen{ $default_inc[0] };
+ }
+
+ return @new_inc;
+}
+
+{
+
+ # Cache this to avoid repeatedly shelling out to Perl.
+ my @inc;
+
+ sub _default_inc {
+ return @inc if @inc;
+
+ local $ENV{PERL5LIB};
+ local $ENV{PERLLIB};
+
+ my $perl = $ENV{HARNESS_PERL} || $^X;
+
+ # Avoid using -l for the benefit of Perl 6
+ chomp( @inc = `"$perl" -e "print join qq[\\n], \@INC, q[]"` );
+ return @inc;
+ }
+}
+
+sub _check_sequence {
+ my @list = @_;
+ my $prev;
+ while ( my $next = shift @list ) {
+ return if defined $prev && $next <= $prev;
+ $prev = $next;
+ }
+
+ return 1;
+}
+
+sub execute_tests {
+ my %args = @_;
+
+ my $harness = _new_harness( \%args );
+ my $aggregate = TAP::Parser::Aggregator->new();
+
+ my %tot = (
+ bonus => 0,
+ max => 0,
+ ok => 0,
+ bad => 0,
+ good => 0,
+ files => 0,
+ tests => 0,
+ sub_skipped => 0,
+ todo => 0,
+ skipped => 0,
+ bench => undef,
+ );
+
+ # Install a callback so we get to see any plans the
+ # harness executes.
+ $harness->callback(
+ made_parser => sub {
+ my $parser = shift;
+ $parser->callback(
+ plan => sub {
+ my $plan = shift;
+ if ( $plan->directive eq 'SKIP' ) {
+ $tot{skipped}++;
+ }
+ }
+ );
+ }
+ );
+
+ local $ENV{PERL_USE_UNSAFE_INC} = 1 if not exists $ENV{PERL_USE_UNSAFE_INC};
+ _aggregate( $harness, $aggregate, @{ $args{tests} } );
+
+ $tot{bench} = $aggregate->elapsed;
+ my @tests = $aggregate->descriptions;
+
+ # TODO: Work out the circumstances under which the files
+ # and tests totals can differ.
+ $tot{files} = $tot{tests} = scalar @tests;
+
+ my %failedtests = ();
+ my %todo_passed = ();
+
+ for my $test (@tests) {
+ my ($parser) = $aggregate->parsers($test);
+
+ my @failed = $parser->failed;
+
+ my $wstat = $parser->wait;
+ my $estat = $parser->exit;
+ my $planned = $parser->tests_planned;
+ my @errors = $parser->parse_errors;
+ my $passed = $parser->passed;
+ my $actual_passed = $parser->actual_passed;
+
+ my $ok_seq = _check_sequence( $parser->actual_passed );
+
+ # Duplicate exit, wait status semantics of old version
+ $estat ||= '' unless $wstat;
+ $wstat ||= '';
+
+ $tot{max} += ( $planned || 0 );
+ $tot{bonus} += $parser->todo_passed;
+ $tot{ok} += $passed > $actual_passed ? $passed : $actual_passed;
+ $tot{sub_skipped} += $parser->skipped;
+ $tot{todo} += $parser->todo;
+
+ if ( @failed || $estat || @errors ) {
+ $tot{bad}++;
+
+ my $huh_planned = $planned ? undef : '??';
+ my $huh_errors = $ok_seq ? undef : '??';
+
+ $failedtests{$test} = {
+ 'canon' => $huh_planned
+ || $huh_errors
+ || _canon(@failed)
+ || '??',
+ 'estat' => $estat,
+ 'failed' => $huh_planned
+ || $huh_errors
+ || scalar @failed,
+ 'max' => $huh_planned || $planned,
+ 'name' => $test,
+ 'wstat' => $wstat
+ };
+ }
+ else {
+ $tot{good}++;
+ }
+
+ my @todo = $parser->todo_passed;
+ if (@todo) {
+ $todo_passed{$test} = {
+ 'canon' => _canon(@todo),
+ 'estat' => $estat,
+ 'failed' => scalar @todo,
+ 'max' => scalar $parser->todo,
+ 'name' => $test,
+ 'wstat' => $wstat
+ };
+ }
+ }
+
+ return ( \%tot, \%failedtests, \%todo_passed );
+}
+
+=head2 execute_tests( tests => \@test_files, out => \*FH )
+
+Runs all the given C<@test_files> (just like C<runtests()>) but
+doesn't generate the final report. During testing, progress
+information will be written to the currently selected output
+filehandle (usually C<STDOUT>), or to the filehandle given by the
+C<out> parameter. The I<out> is optional.
+
+Returns a list of two values, C<$total> and C<$failed>, describing the
+results. C<$total> is a hash ref summary of all the tests run. Its
+keys and values are this:
+
+ bonus Number of individual todo tests unexpectedly passed
+ max Number of individual tests ran
+ ok Number of individual tests passed
+ sub_skipped Number of individual tests skipped
+ todo Number of individual todo tests
+
+ files Number of test files ran
+ good Number of test files passed
+ bad Number of test files failed
+ tests Number of test files originally given
+ skipped Number of test files skipped
+
+If C<< $total->{bad} == 0 >> and C<< $total->{max} > 0 >>, you've
+got a successful test.
+
+C<$failed> is a hash ref of all the test scripts that failed. Each key
+is the name of a test script, each value is another hash representing
+how that script failed. Its keys are these:
+
+ name Name of the test which failed
+ estat Script's exit value
+ wstat Script's wait status
+ max Number of individual tests
+ failed Number which failed
+ canon List of tests which failed (as string).
+
+C<$failed> should be empty if everything passed.
+
+=cut
+
+1;
+__END__
+
+=head1 EXPORT
+
+C<&runtests> is exported by C<Test::Harness> by default.
+
+C<&execute_tests>, C<$verbose>, C<$switches> and C<$debug> are
+exported upon request.
+
+=head1 ENVIRONMENT VARIABLES THAT TAP::HARNESS::COMPATIBLE SETS
+
+C<Test::Harness> sets these before executing the individual tests.
+
+=over 4
+
+=item C<HARNESS_ACTIVE>
+
+This is set to a true value. It allows the tests to determine if they
+are being executed through the harness or by any other means.
+
+=item C<HARNESS_VERSION>
+
+This is the version of C<Test::Harness>.
+
+=back
+
+=head1 ENVIRONMENT VARIABLES THAT AFFECT TEST::HARNESS
+
+=over 4
+
+=item C<HARNESS_PERL_SWITCHES>
+
+Setting this adds perl command line switches to each test file run.
+
+For example, C<HARNESS_PERL_SWITCHES=-T> will turn on taint mode.
+C<HARNESS_PERL_SWITCHES=-MDevel::Cover> will run C<Devel::Cover> for
+each test.
+
+C<-w> is always set. You can turn this off in the test with C<BEGIN {
+$^W = 0 }>.
+
+=item C<HARNESS_TIMER>
+
+Setting this to true will make the harness display the number of
+milliseconds each test took. You can also use F<prove>'s C<--timer>
+switch.
+
+=item C<HARNESS_VERBOSE>
+
+If true, C<Test::Harness> will output the verbose results of running
+its tests. Setting C<$Test::Harness::verbose> will override this,
+or you can use the C<-v> switch in the F<prove> utility.
+
+=item C<HARNESS_OPTIONS>
+
+Provide additional options to the harness. Currently supported options are:
+
+=over
+
+=item C<< j<n> >>
+
+Run <n> (default 9) parallel jobs.
+
+=item C<< c >>
+
+Try to color output. See L<TAP::Formatter::Base/"new">.
+
+=item C<< a<file.tgz> >>
+
+Will use L<TAP::Harness::Archive> as the harness class, and save the TAP to
+C<file.tgz>
+
+=item C<< fPackage-With-Dashes >>
+
+Set the formatter_class of the harness being run. Since the C<HARNESS_OPTIONS>
+is separated by C<:>, we use C<-> instead.
+
+=back
+
+Multiple options may be separated by colons:
+
+ HARNESS_OPTIONS=j9:c make test
+
+=item C<HARNESS_SUBCLASS>
+
+Specifies a TAP::Harness subclass to be used in place of TAP::Harness.
+
+=item C<HARNESS_SUMMARY_COLOR_SUCCESS>
+
+Determines the L<Term::ANSIColor> for the summary in case it is successful.
+This color defaults to C<'green'>.
+
+=item C<HARNESS_SUMMARY_COLOR_FAIL>
+
+Determines the L<Term::ANSIColor> for the failure in case it is successful.
+This color defaults to C<'red'>.
+
+=back
+
+=head1 Taint Mode
+
+Normally when a Perl program is run in taint mode the contents of the
+C<PERL5LIB> environment variable do not appear in C<@INC>.
+
+Because C<PERL5LIB> is often used during testing to add build
+directories to C<@INC> C<Test::Harness> passes the names of any
+directories found in C<PERL5LIB> as -I switches. The net effect of this
+is that C<PERL5LIB> is honoured even in taint mode.
+
+=head1 SEE ALSO
+
+L<TAP::Harness>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-test-harness at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Test-Harness>. I will be
+notified, and then you'll automatically be notified of progress on your bug
+as I make changes.
+
+=head1 AUTHORS
+
+Andy Armstrong C<< <andy@hexten.net> >>
+
+L<Test::Harness> 2.64 (maintained by Andy Lester and on which this
+module is based) has this attribution:
+
+ Either Tim Bunce or Andreas Koenig, we don't know. What we know for
+ sure is, that it was inspired by Larry Wall's F<TEST> script that came
+ with perl distributions for ages. Numerous anonymous contributors
+ exist. Andreas Koenig held the torch for many years, and then
+ Michael G Schwern.
+
+=head1 LICENCE AND COPYRIGHT
+
+Copyright (c) 2007-2011, Andy Armstrong C<< <andy@hexten.net> >>. All rights reserved.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm
index 22660a154e..4f0e5956b0 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm
@@ -2,7 +2,7 @@ package Test::Needs;
use strict;
use warnings;
no warnings 'once';
-our $VERSION = '0.002009';
+our $VERSION = '0.002010';
$VERSION =~ tr/_//d;
BEGIN {
@@ -175,27 +175,29 @@ sub _fail_or_skip {
my $tb = Test::Builder->new;
my $has_plan = Test::Builder->can('has_plan') ? 'has_plan'
: sub { $_[0]->expected_tests || eval { $_[0]->current_test($_[0]->current_test); 'no_plan' } };
+ my $tests = $tb->current_test;
if ($fail) {
$tb->plan(tests => 1)
unless $tb->$has_plan;
+ $tests++;
$tb->ok(0, "Test::Needs modules available");
$tb->diag($message);
}
else {
my $plan = $tb->$has_plan;
- my $tests = $tb->current_test;
if ($plan || $tests) {
my $skips
= $plan && $plan ne 'no_plan' ? $plan - $tests : 1;
$tb->skip("Test::Needs modules not available")
for 1 .. $skips;
+ $tests += $skips;
Test::Builder->can('note') ? $tb->note($message) : print "# $message\n";
}
else {
$tb->skip_all($message);
}
}
- $tb->done_testing
+ $tb->done_testing($tests)
if Test::Builder->can('done_testing');
die bless {} => 'Test::Builder::Exception'
if Test::Builder->can('parent') && $tb->parent;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Warnings.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Warnings.pm
new file mode 100755
index 0000000000..d2dd6507e6
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Warnings.pm
@@ -0,0 +1,587 @@
+use strict;
+use warnings;
+package Test::Warnings; # git description: v0.032-4-ge6f3f36
+# vim: set ts=8 sts=2 sw=2 tw=100 et :
+# ABSTRACT: Test for warnings and the lack of them
+# KEYWORDS: testing tests warnings
+
+our $VERSION = '0.033';
+
+use parent 'Exporter';
+use Test::Builder;
+
+our @EXPORT_OK = qw(
+ allow_warnings allowing_warnings
+ had_no_warnings
+ warnings warning
+ allow_patterns
+ disallow_patterns
+);
+our %EXPORT_TAGS = ( all => \@EXPORT_OK );
+
+my $warnings_allowed;
+my $forbidden_warnings_found;
+my $done_testing_called;
+my $no_end_test;
+my $fail_on_warning;
+my $report_warnings;
+my @collected_warnings;
+my @allowed_patterns;
+
+sub import {
+ my $class = shift @_;
+
+ my %names; @names{@_} = ();
+ # END block will check for this status
+ $no_end_test = exists $names{':no_end_test'};
+ # __WARN__ handler will check for this status
+ $fail_on_warning = exists $names{':fail_on_warning'};
+ # Collect and report warnings at the end
+ $report_warnings = exists $names{':report_warnings'};
+
+ delete @names{qw(:no_end_test :fail_on_warning :report_warnings)};
+ __PACKAGE__->export_to_level(1, $class, keys %names);
+}
+
+# swap this out for testing this module only!
+my $tb;
+sub _builder(;$) {
+ if (not @_) {
+ $tb ||= Test::Builder->new;
+ return $tb;
+ }
+
+ $tb = shift;
+}
+
+my $_orig_warn_handler = $SIG{__WARN__};
+$SIG{__WARN__} = sub {
+ if ($warnings_allowed or grep +($_[0] =~ $_), @allowed_patterns) {
+ Test::Builder->new->note($_[0]);
+ }
+ else {
+ $forbidden_warnings_found++;
+ push @collected_warnings, $_[0] if $report_warnings;
+
+ # TODO: this doesn't handle blessed coderefs... does anyone care?
+ goto &$_orig_warn_handler if $_orig_warn_handler
+ and ( (ref $_orig_warn_handler eq 'CODE')
+ or ($_orig_warn_handler ne 'DEFAULT'
+ and $_orig_warn_handler ne 'IGNORE'
+ and defined &$_orig_warn_handler));
+
+ if ($_[0] =~ /\n$/) {
+ warn $_[0];
+ } else {
+ require Carp;
+ Carp::carp($_[0]);
+ }
+ _builder->ok(0, 'unexpected warning') if $fail_on_warning;
+ }
+};
+
+sub warnings(;&) {
+ # if someone manually does warnings->import in the same namespace this is
+ # imported into, this sub will be called. in that case, just return the
+ # string "warnings" so it calls the correct method.
+ if (!@_) {
+ return 'warnings';
+ }
+ my $code = shift;
+ my @warnings;
+ local $SIG{__WARN__} = sub {
+ push @warnings, shift;
+ };
+ $code->();
+ @warnings;
+}
+
+sub warning(&) {
+ my @warnings = &warnings(@_);
+ return @warnings == 1 ? $warnings[0] : \@warnings;
+}
+
+if (Test::Builder->can('done_testing')) {
+ # monkeypatch Test::Builder::done_testing:
+ # check for any forbidden warnings, and record that we have done so
+ # so we do not check again via END
+
+ no strict 'refs';
+ my $orig = *{'Test::Builder::done_testing'}{CODE};
+ no warnings 'redefine';
+ *{'Test::Builder::done_testing'} = sub {
+ # only do this at the end of all tests, not at the end of a subtest
+ my $builder = _builder;
+ my $in_subtest_sub = $builder->can('in_subtest');
+ if (not $no_end_test
+ and not ($in_subtest_sub ? $builder->$in_subtest_sub : $builder->parent)) {
+ local $Test::Builder::Level = $Test::Builder::Level + 3;
+ had_no_warnings('no (unexpected) warnings (via done_testing)');
+ $done_testing_called = 1;
+ }
+
+ $orig->(@_);
+ };
+}
+
+if ($INC{'Test2/Tools/Basic.pm'}) {
+ # monkeypatch Test2::Tools::Basic::done_testing:
+ # check for any forbidden warnings, and record that we have done so
+ # so we do not check again via END
+
+ no strict 'refs';
+ my $orig = *{'Test2::Tools::Basic::done_testing'}{CODE};
+ no warnings 'redefine';
+ *{'Test2::Tools::Basic::done_testing'} = sub {
+ if (not $no_end_test) {
+ # we could use $ctx to create the test, which means not having to adjust Level,
+ # but then we need to make _builder Test2-compatible, which seems like a PITA.
+ local $Test::Builder::Level = $Test::Builder::Level + 3;
+ had_no_warnings('no (unexpected) warnings (via done_testing)');
+ $done_testing_called = 1;
+ }
+
+ $orig->(@_);
+ };
+}
+
+END {
+ if (not $no_end_test
+ and not $done_testing_called
+ # skip this if there is no plan and no tests have been run (e.g.
+ # compilation tests of this module!)
+ and (_builder->expected_tests or _builder->current_test > 0)
+ ) {
+ local $Test::Builder::Level = $Test::Builder::Level + 1;
+ had_no_warnings('no (unexpected) warnings (via END block)');
+ }
+}
+
+# setter
+sub allow_warnings(;$) {
+ $warnings_allowed = @_ || defined $_[0] ? $_[0] : 1;
+}
+
+# getter
+sub allowing_warnings() { $warnings_allowed }
+
+# call at any time to assert no (unexpected) warnings so far
+sub had_no_warnings(;$) {
+ if ($ENV{PERL_TEST_WARNINGS_ONLY_REPORT_WARNINGS}) {
+ $forbidden_warnings_found
+ and _builder->diag("Found $forbidden_warnings_found warnings but allowing them because PERL_TEST_WARNINGS_ONLY_REPORT_WARNINGS is set");
+ }
+ else {
+ _builder->ok(!$forbidden_warnings_found, shift || 'no (unexpected) warnings');
+ }
+ if (($report_warnings or $ENV{PERL_TEST_WARNINGS_ONLY_REPORT_WARNINGS})
+ and $forbidden_warnings_found) {
+ _builder->diag("Got the following unexpected warnings:");
+ for my $i (1 .. @collected_warnings) {
+ _builder->diag(" $i: $collected_warnings[ $i - 1 ]");
+ }
+ }
+}
+
+# pass one or more regexes (in qr format)
+# when called in void context, lasting effect is universal
+# otherwise, returns objects: when they go out of scope, the effect is removed
+# (warning disallowed again).
+sub allow_patterns(@) {
+ push @allowed_patterns, @_;
+ return if not defined wantarray;
+ return [ map +Test::Warnings::TemporaryWarning->new($_), @_ ];
+}
+
+sub disallow_patterns(@) {
+ foreach my $pattern (@_) {
+ @allowed_patterns = grep +($_ ne $pattern), @allowed_patterns;
+ }
+}
+
+package # hide from PAUSE
+ Test::Warnings::TemporaryWarning;
+
+sub new {
+ my ($class, $pattern) = @_;
+ bless \$pattern, $class;
+}
+
+sub DESTROY {
+ Test::Warnings::disallow_patterns(${$_[0]});
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test::Warnings - Test for warnings and the lack of them
+
+=head1 VERSION
+
+version 0.033
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use Test::Warnings;
+
+ pass('yay!');
+ done_testing;
+
+emits TAP:
+
+ ok 1 - yay!
+ ok 2 - no (unexpected) warnings (via done_testing)
+ 1..2
+
+and:
+
+ use Test::More tests => 3;
+ use Test::Warnings 0.005 ':all';
+
+ pass('yay!');
+ like(warning { warn "oh noes!" }, qr/^oh noes/, 'we warned');
+
+emits TAP:
+
+ ok 1 - yay!
+ ok 2 - we warned
+ ok 3 - no (unexpected) warnings (via END block)
+ 1..3
+
+=head1 DESCRIPTION
+
+If you've ever tried to use L<Test::NoWarnings> to confirm there are no warnings
+generated by your tests, combined with the convenience of C<done_testing> to
+not have to declare a
+L<test count|Test::More/I love it-when-a-plan-comes-together>,
+you'll have discovered that these two features do not play well together,
+as the test count will be calculated I<before> the warnings test is run,
+resulting in a TAP error. (See C<examples/test_nowarnings.pl> in this
+distribution for a demonstration.)
+
+This module is intended to be used as a drop-in replacement for
+L<Test::NoWarnings>: it also adds an extra test, but runs this test I<before>
+C<done_testing> calculates the test count, rather than after. It does this by
+hooking into C<done_testing> as well as via an C<END> block. You can declare
+a plan, or not, and things will still Just Work.
+
+It is actually equivalent to:
+
+ use Test::NoWarnings 1.04 ':early';
+
+as warnings are still printed normally as they occur. You are safe, and
+enthusiastically encouraged, to perform a global search-replace of the above
+with C<use Test::Warnings;> whether or not your tests have a plan.
+
+It can also be used as a replacement for L<Test::Warn>, if you wish to test
+the content of expected warnings; read on to find out how.
+
+=head1 FUNCTIONS
+
+The following functions are available for import (not included by default; you
+can also get all of them by importing the tag C<:all>):
+
+=head2 C<< allow_warnings([bool]) >> - EXPERIMENTAL - MAY BE REMOVED
+
+When passed a true value, or no value at all, subsequent warnings will not
+result in a test failure; when passed a false value, subsequent warnings will
+result in a test failure. Initial value is C<false>.
+
+When warnings are allowed, any warnings will instead be emitted via
+L<Test::Builder::note|Test::Builder/Output>.
+
+=head2 C<allowing_warnings> - EXPERIMENTAL - MAY BE REMOVED
+
+Returns whether we are currently allowing warnings (set by C<allow_warnings>
+as described above).
+
+=head2 C<< had_no_warnings(<optional test name>) >>
+
+Tests whether there have been any warnings so far, not preceded by an
+C<allowing_warnings> call. It is run
+automatically at the end of all tests, but can also be called manually at any
+time, as often as desired.
+
+=head2 C<< warnings( { code } ) >>
+
+Given a code block, runs the block and returns a list of all the
+(not previously allowed via C<allow_warnings>) warnings issued within. This
+lets you test for the presence of warnings that you not only would I<allow>,
+but I<must> be issued. Testing functions are not provided; given the strings
+returned, you can test these yourself using your favourite testing functions,
+such as L<Test::More::is|Test::More/is> or L<Test::Deep::cmp_deeply|Test::Deep/cmp_deeply>.
+
+You can use this construct as a replacement for
+L<Test::Warn::warnings_are|Test::Warn/warnings_are>:
+
+ is_deeply(
+ [ warnings { ... } ],
+ [
+ 'warning message 1',
+ 'warning message 2',
+ ],
+ 'got expected warnings',
+ );
+
+or, to replace L<Test::Warn::warnings_like|Test::Warn/warnings_like>:
+
+ cmp_deeply(
+ [ warnings { ... } ],
+ bag( # ordering of messages doesn't matter
+ re(qr/warning message 1/),
+ re(qr/warning message 2/),
+ ),
+ 'got expected warnings (in any order)',
+ );
+
+Warnings generated by this code block are I<NOT> propagated further. However,
+since they are returned from this function with their filename and line
+numbers intact, you can re-issue them yourself immediately after calling
+C<warnings(...)>, if desired.
+
+Note that C<use Test::Warnings 'warnings'> will give you a C<warnings>
+subroutine in your namespace (most likely C<main>, if you're writing a test),
+so you (or things you load) can't subsequently do C<< warnings->import >> --
+it will result in the error: "Not enough arguments for
+Test::Warnings::warnings at ..., near "warnings->import"". To work around
+this, either use the fully-qualified form (C<Test::warnings>) or make your
+calls to the C<warnings> package first.
+
+=head2 C<< warning( { code } ) >>
+
+Same as C<< warnings( { code } ) >>, except a scalar is always returned - the
+single warning produced, if there was one, or an arrayref otherwise -- which
+can be more convenient to use than C<warnings()> if you are expecting exactly
+one warning.
+
+However, you are advised to capture the result from C<warning()> into a temp
+variable so you can dump its value if it doesn't contain what you expect.
+e.g. with this test:
+
+ like(
+ warning { foo() },
+ qr/^this is a warning/,
+ 'got a warning from foo()',
+ );
+
+if you get two warnings (or none) back instead of one, you'll get an
+arrayref, which will result in an unhelpful test failure message like:
+
+ # Failed test 'got a warning from foo()'
+ # at t/mytest.t line 10.
+ # 'ARRAY(0xdeadbeef)'
+ # doesn't match '(?^:^this is a warning)'
+
+So instead, change your test to:
+
+ my $warning = warning { foo() };
+ like(
+ $warning,
+ qr/^this is a warning/,
+ 'got a warning from foo()',
+ ) or diag 'got warning(s): ', explain($warning);
+
+=head2 allow_patterns
+
+ allow_patterns(qr/always allow this warning/);
+ {
+ my $temp = allow_patterns(qr/only allow in this scope/, qr/another temporary warning/);
+ ... stuff ...
+ }
+
+Given one or more regular expressions, in C<qr/.../> form, add them to the allow-list (warnings will
+be emitted with C<note> rather than triggering the warning handler). If the return value is saved in
+a local variable, the warning exemption will only be in effect for that local scope (the addition is
+reversed at the end of the scope); otherwise, the effect is global.
+
+=head2 disallow_patterns
+
+Given one or more regular expressions, in C<qr/.../> form, remove it from the allow-list. The
+pattern must exactly match a pattern previously provided to L</allow_patterns>.
+
+=head1 IMPORT OPTIONS
+
+=head2 C<:all>
+
+Imports all functions listed above
+
+=head2 C<:no_end_test>
+
+Disables the addition of a C<had_no_warnings> test
+via C<END> or C<done_testing>
+
+=head2 C<:fail_on_warning>
+
+=for stopwords unexempted
+
+When used, fail immediately when an unexempted warning is generated (as opposed to waiting until
+L</had_no_warnings> or C<done_testing> is called).
+
+I recommend you only turn this option on when debugging a test, to see where a surprise warning is coming from,
+and rely on the end-of-tests check otherwise.
+
+=head2 C<:report_warnings>
+
+When used, C<had_no_warnings()> will print all the unexempted warning content, in case it had been suppressed
+earlier by other captures (such as L<Test::Output/stderr_like> or L<Capture::Tiny/capture>).
+
+=head1 OTHER OPTIONS
+
+You can temporarily turn off the failure behaviour of this module, swapping it out for reporting
+(see C<:report_warnings> above) with:
+
+ $ENV{PERL_TEST_WARNINGS_ONLY_REPORT_WARNINGS} = 1;
+
+This can be useful for working around problematic modules that have warnings in newer Perl versions.
+
+=head1 CAVEATS
+
+=for stopwords smartmatch TODO irc
+
+Sometimes new warnings can appear in Perl that should B<not> block
+installation -- for example, smartmatch was recently deprecated in
+perl 5.17.11, so now any distribution that uses smartmatch and also
+tests for warnings cannot be installed under 5.18.0. You might want to
+consider only making warnings fail tests in an author environment -- you can
+do this with the L<if> pragma:
+
+ use if $ENV{AUTHOR_TESTING} || $ENV{RELEASE_TESTING}, 'Test::Warnings';
+
+In future versions of this module, when interfaces are added to test the
+content of warnings, there will likely be additional sugar available to
+indicate that warnings should be checked only in author tests (or TODO when
+not in author testing), but will still provide exported subs. Comments are
+enthusiastically solicited - drop me an email, write up an RT ticket, or come
+by C<#perl-qa> on irc!
+
+=for stopwords Achtung
+
+B<Achtung!> This is not a great idea:
+
+ sub warning_like(&$;$) {
+ my ($code, $pattern, $name) = @_;
+ like( &warning($code), $pattern, $name );
+ }
+
+ warning_like( { ... }, qr/foo/, 'foo appears in the warning' );
+
+If the code in the C<{ ... }> is going to warn with a stack trace with the
+arguments to each subroutine in its call stack (for example via C<Carp::cluck>),
+the test name, "foo appears in the warning" will itself be matched by the
+regex (see F<examples/warning_like.t>). Instead, write this:
+
+ like( warning { ... }, qr/foo/, 'foo appears in the warning' );
+
+=head1 CAVEATS
+
+If you are using another module that sets its own warning handler (for example L<Devel::Confess> or
+L<diagnostics>) your results may be mixed, as those handlers will interfere with this module's
+ability to properly detect and capture warnings in their original form.
+
+=head1 TO DO (or: POSSIBLE FEATURES COMING IN FUTURE RELEASES)
+
+=over
+
+=item * C<< allow_warnings(qr/.../) >> - allow some warnings and not others
+
+=for stopwords subtest subtests
+
+=item * more sophisticated handling in subtests - if we save some state on the
+L<Test::Builder> object itself, we can allow warnings in a subtest and then
+the state will revert when the subtest ends, as well as check for warnings at
+the end of every subtest via C<done_testing>.
+
+=item * sugar for making failures TODO when testing outside an author
+environment
+
+=back
+
+=head1 SEE ALSO
+
+=for stopwords YANWT
+
+=over 4
+
+=item *
+
+L<Test::NoWarnings>
+
+=item *
+
+L<Test::FailWarnings>
+
+=item *
+
+L<blogs.perl.org: YANWT (Yet Another No-Warnings Tester)|http://blogs.perl.org/users/ether/2013/03/yanwt-yet-another-no-warnings-tester.html>
+
+=item *
+
+L<strictures> - which makes all warnings fatal in tests, hence lessening the need for special warning testing
+
+=item *
+
+L<Test::Warn>
+
+=item *
+
+L<Test::Fatal>
+
+=back
+
+=head1 SUPPORT
+
+Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Test-Warnings>
+(or L<bug-Test-Warnings@rt.cpan.org|mailto:bug-Test-Warnings@rt.cpan.org>).
+
+There is also a mailing list available for users of this distribution, at
+L<http://lists.perl.org/list/perl-qa.html>.
+
+There is also an irc channel available for users of this distribution, at
+L<C<#perl> on C<irc.perl.org>|irc://irc.perl.org/#perl-qa>.
+
+I am also usually active on irc, as 'ether' at C<irc.perl.org> and C<irc.libera.chat>.
+
+=head1 AUTHOR
+
+Karen Etheridge <ether@cpan.org>
+
+=head1 CONTRIBUTORS
+
+=for stopwords Graham Knop A. Sinan Unur Leon Timmermans Tina Mueller
+
+=over 4
+
+=item *
+
+Graham Knop <haarg@haarg.org>
+
+=item *
+
+A. Sinan Unur <nanis@cpan.org>
+
+=item *
+
+Leon Timmermans <fawaka@gmail.com>
+
+=item *
+
+Tina Mueller <cpan2@tinita.de>
+
+=back
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is copyright (c) 2013 by Karen Etheridge.
+
+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/URI.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm
index 9cde9dd113..c80cb43c7a 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm
@@ -3,7 +3,10 @@ package URI;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
+
+# 1=version 5.10 and earlier; 0=version 5.11 and later
+use constant HAS_RESERVED_SQUARE_BRACKETS => $ENV{URI_HAS_RESERVED_SQUARE_BRACKETS} ? 1 : 0;
our ($ABS_REMOTE_LEADING_DOTS, $ABS_ALLOW_RELATIVE_SCHEME, $DEFAULT_QUERY_FORM_DELIMITER);
@@ -11,13 +14,29 @@ my %implements; # mapping from scheme to implementor class
# Some "official" character classes
-our $reserved = q(;/?:@&=+$,[]);
+our $reserved = HAS_RESERVED_SQUARE_BRACKETS ? q(;/?:@&=+$,[]) : q(;/?:@&=+$,);
our $mark = q(-_.!~*'()); #'; emacs
our $unreserved = "A-Za-z0-9\Q$mark\E";
our $uric = quotemeta($reserved) . $unreserved . "%";
+our $uric4host = $uric . ( HAS_RESERVED_SQUARE_BRACKETS ? '' : quotemeta( q([]) ) );
+our $uric4user = quotemeta( q{!$'()*,;:._~%-+=%&} ) . "A-Za-z0-9" . ( HAS_RESERVED_SQUARE_BRACKETS ? quotemeta( q([]) ) : '' ); # RFC-3987: iuserinfo w/o UTF
our $scheme_re = '[a-zA-Z][a-zA-Z0-9.+\-]*';
+# These schemes don't have an IPv6+ address part.
+our $schemes_without_host_part_re = 'data|ldapi|urn|sqlite|sqlite3';
+
+# These schemes can have an IPv6+ authority part:
+# file, ftp, gopher, http, https, ldap, ldaps, mms, news, nntp, nntps, pop, rlogin, rtsp, rtspu, rsync, sip, sips, snews,
+# telnet, tn3270, ssh, sftp
+# (all DB URIs, i.e. cassandra, couch, couchdb, etc.), except 'sqlite:', 'sqlite3:'. Others?
+#MAINT: URI has no test coverage for DB schemes
+#MAINT: decoupling - perhaps let each class decide itself by defining a member function 'scheme_has_authority_part()'?
+
+#MAINT: 'mailto:' needs special treatment for IPv* addresses / RFC 5321 (4.1.3). Until then: restore all '[', ']'
+# These schemes need fallback to previous (<= 5.10) encoding until a specific handler is available.
+our $fallback_schemes_re = 'mailto';
+
use Carp ();
use URI::Escape ();
@@ -38,7 +57,7 @@ sub new
$uri = defined ($uri) ? "$uri" : ""; # stringify
# Get rid of potential wrapping
- $uri =~ s/^<(?:URL:)?(.*)>$/$1/; #
+ $uri =~ s/^<(?:URL:)?(.*)>$/$1/; #
$uri =~ s/^"(.*)"$/$1/;
$uri =~ s/^\s+//;
$uri =~ s/\s+$//;
@@ -86,10 +105,42 @@ sub _init
}
+#-- Version: 5.11+
+# Since the complete URI will be percent-encoded including '[' and ']',
+# we selectively unescape square brackets from the authority/host part of the URI.
+# Derived modules that implement _uric_escape() should take this into account
+# if they do not rely on URI::_uric_escape().
+# No unescaping is performed for the userinfo@ part of the authority part.
+sub _fix_uric_escape_for_host_part {
+ return if HAS_RESERVED_SQUARE_BRACKETS;
+ return if $_[0] !~ /%/;
+ return if $_[0] =~ m{^(?:$URI::schemes_without_host_part_re):}os;
+
+ # until a scheme specific handler is available, fall back to previous behavior of v5.10 (i.e. 'mailto:')
+ if ($_[0] =~ m{^(?:$URI::fallback_schemes_re):}os) {
+ $_[0] =~ s/\%5B/[/gi;
+ $_[0] =~ s/\%5D/]/gi;
+ return;
+ }
+
+ if ($_[0] =~ m{^((?:$URI::scheme_re:)?)//([^/?\#]+)(.*)$}os) {
+ my $orig = $2;
+ my ($user, $host) = $orig =~ /^(.*@)?([^@]*)$/;
+ $user ||= '';
+ my $port = $host =~ s/(:\d+)$// ? $1 : '';
+ #MAINT: die() here if scheme indicates TCP/UDP and port is out of range [0..65535] ?
+ $host =~ s/\%5B/[/gi;
+ $host =~ s/\%5D/]/gi;
+ $_[0] =~ s/\Q$orig\E/$user$host$port/;
+ }
+}
+
+
sub _uric_escape
{
my($class, $str) = @_;
$str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;
+ _fix_uric_escape_for_host_part( $str );
utf8::downgrade($str);
return $str;
}
@@ -130,6 +181,8 @@ sub implementor
# check we actually have one for the scheme:
unless (@{"${ic}::ISA"}) {
if (not exists $require_attempted{$ic}) {
+ $require_attempted{$ic} = 1;
+
# Try to load it
my $_old_error = $@;
eval "require $ic";
@@ -179,7 +232,7 @@ sub _scheme
Carp::croak("Bad scheme '$new'") unless $new =~ /^$scheme_re$/o;
$old = $1 if $$self =~ s/^($scheme_re)://o;
my $newself = URI->new("$new:$$self");
- $$self = $$newself;
+ $$self = $$newself;
bless $self, ref($newself);
}
else {
@@ -708,8 +761,79 @@ documents as this avoids the trouble of escaping the "&" character.
You might also set the $URI::DEFAULT_QUERY_FORM_DELIMITER variable to
";" for the same global effect.
-The C<URI::QueryParam> module can be loaded to add further methods to
-manipulate the form of a URI. See L<URI::QueryParam> for details.
+=item @keys = $u->query_param
+
+=item @values = $u->query_param( $key )
+
+=item $first_value = $u->query_param( $key )
+
+=item $u->query_param( $key, $value,... )
+
+If $u->query_param is called with no arguments, it returns all the
+distinct parameter keys of the URI. In a scalar context it returns the
+number of distinct keys.
+
+When a $key argument is given, the method returns the parameter values with the
+given key. In a scalar context, only the first parameter value is
+returned.
+
+If additional arguments are given, they are used to update successive
+parameters with the given key. If any of the values provided are
+array references, then the array is dereferenced to get the actual
+values.
+
+Please note that you can supply multiple values to this method, but you cannot
+supply multiple keys.
+
+Do this:
+
+ $uri->query_param( widget_id => 1, 5, 9 );
+
+Do NOT do this:
+
+ $uri->query_param( widget_id => 1, frobnicator_id => 99 );
+
+=item $u->query_param_append($key, $value,...)
+
+Adds new parameters with the given
+key without touching any old parameters with the same key. It
+can be explained as a more efficient version of:
+
+ $u->query_param($key,
+ $u->query_param($key),
+ $value,...);
+
+One difference is that this expression would return the old values
+of $key, whereas the query_param_append() method does not.
+
+=item @values = $u->query_param_delete($key)
+
+=item $first_value = $u->query_param_delete($key)
+
+Deletes all key/value pairs with the given key.
+The old values are returned. In a scalar context, only the first value
+is returned.
+
+Using the query_param_delete() method is slightly more efficient than
+the equivalent:
+
+ $u->query_param($key, []);
+
+=item $hashref = $u->query_form_hash
+
+=item $u->query_form_hash( \%new_form )
+
+Returns a reference to a hash that represents the
+query form's key/value pairs. If a key occurs multiple times, then the hash
+value becomes an array reference.
+
+Note that sequence information is lost. This means that:
+
+ $u->query_form_hash($u->query_form_hash);
+
+is not necessarily a no-op, as it may reorder the key/value pairs.
+The values returned by the query_param() method should stay the same
+though.
=item $uri->query_keywords
@@ -754,7 +878,7 @@ every case where it has been used.
Sets and returns the unescaped hostname.
-If the $new_host string ends with a colon and a number, then this
+If the C<$new_host> string ends with a colon and a number, then this
number also sets the port.
For IPv6 addresses the brackets around the raw address is removed in the return
@@ -762,9 +886,17 @@ value from $uri->host. When setting the host attribute to an IPv6 address you
can use a raw address or one enclosed in brackets. The address needs to be
enclosed in brackets if you want to pass in a new port value as well.
+ my $uri = URI->new("http://www.\xC3\xBCri-sample/foo/bar.html");
+ print $u->host; # www.xn--ri-sample-fra0f
+
+
=item $uri->ihost
-Returns the host in Unicode form. Any IDNA A-labels are turned into U-labels.
+Returns the host in Unicode form. Any IDNA A-labels (encoded unicode chars with
+I<xn--> prefix) are turned into U-labels (unicode chars).
+
+ my $uri = URI->new("http://www.\xC3\xBCri-sample/foo/bar.html");
+ print $u->ihost; # www.\xC3\xBCri-sample
=item $uri->port
@@ -864,6 +996,30 @@ implemented. The scheme is used to reference HTTP servers through SSL
connections. Its syntax is the same as http, but the default
port is different.
+=item B<geo>:
+
+The I<geo> URI scheme is specified in L<RFC 5870|http://tools.ietf.org/html/rfc5870>.
+The scheme is used to reference physical location in a two- or
+three-dimensional coordinate reference system in a compact, simple,
+human-readable, and protocol-independent way.
+
+C<URI> objects belonging to the geo scheme support the common methods.
+
+=item B<icap>:
+
+The I<icap> URI scheme is specified in L<RFC 3507|http://tools.ietf.org/html/rfc3507>.
+The scheme is used to reference resources hosted by ICAP servers.
+
+C<URI> objects belonging to the icap scheme support the common,
+generic and server methods.
+
+=item B<icaps>:
+
+The I<icaps> URI scheme is specified in L<RFC 3507|http://tools.ietf.org/html/rfc3507> as well.
+The scheme is used to reference ICAP servers through SSL
+connections. Its syntax is the same as icap, including the same
+default port.
+
=item B<ldap>:
The I<ldap> URI scheme is specified in RFC 2255. LDAP is the
@@ -1087,6 +1243,34 @@ delimited by ";" instead of "&" which is the default.
=back
+=head1 ENVIRONMENT VARIABLES
+
+=over 4
+
+=item URI_HAS_RESERVED_SQUARE_BRACKETS
+
+Before version 5.11, URI treated square brackets as reserved characters
+throughout the whole URI string. However, these brackets are reserved
+only within the authority/host part of the URI and nowhere else (RFC 3986).
+
+Starting with version 5.11, URI takes this distinction into account.
+Setting the environment variable C<URI_HAS_RESERVED_SQUARE_BRACKETS>
+(programmatically or via the shell), restores the old behavior.
+
+ #-- restore 5.10 behavior programmatically
+ BEGIN {
+ $ENV{URI_HAS_RESERVED_SQUARE_BRACKETS} = 1;
+ }
+ use URI ();
+
+I<Note>: This environment variable is just used during initialization and has to be set
+ I<before> module URI is used/required. Changing it at run time has no effect.
+
+Its value can be checked programmatically by accessing the constant
+C<URI::HAS_RESERVED_SQUARE_BRACKETS>.
+
+=back
+
=head1 BUGS
There are some things that are not quite right:
@@ -1129,7 +1313,7 @@ readable alternative.
=head1 SEE ALSO
-L<URI::file>, L<URI::WithBase>, L<URI::QueryParam>, L<URI::Escape>,
+L<URI::file>, L<URI::WithBase>, L<URI::Escape>,
L<URI::Split>, L<URI::Heuristic>
RFC 2396: "Uniform Resource Identifiers (URI): Generic Syntax",
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm
index 5760bb55b0..c784c81fe0 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm
@@ -71,6 +71,13 @@ as the reserved characters. I.e. the default is:
"^A-Za-z0-9\-\._~"
+The second argument can also be specified as a regular expression object:
+
+ qr/[^A-Za-z]/
+
+Any strings matched by this regular expression will have all of their
+characters escaped.
+
=item uri_escape_utf8( $string )
=item uri_escape_utf8( $string, $unsafe )
@@ -141,7 +148,7 @@ use Exporter 5.57 'import';
our %escapes;
our @EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
our @EXPORT_OK = qw(%escapes);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use Carp ();
@@ -160,17 +167,37 @@ my %Unsafe = (
sub uri_escape {
my($text, $patn) = @_;
return undef unless defined $text;
+ my $re;
if (defined $patn){
- unless (exists $subst{$patn}) {
- # Because we can't compile the regex we fake it with a cached sub
- (my $tmp = $patn) =~ s,/,\\/,g;
- eval "\$subst{\$patn} = sub {\$_[0] =~ s/([$tmp])/\$escapes{\$1} || _fail_hi(\$1)/ge; }";
- Carp::croak("uri_escape: $@") if $@;
+ if (ref $patn eq 'Regexp') {
+ $text =~ s{($patn)}{
+ join('', map +($escapes{$_} || _fail_hi($_)), split //, "$1")
+ }ge;
+ return $text;
}
- &{$subst{$patn}}($text);
- } else {
- $text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge;
+ $re = $subst{$patn};
+ if (!defined $re) {
+ $re = $patn;
+ # we need to escape the [] characters, except for those used in
+ # posix classes. if they are prefixed by a backslash, allow them
+ # through unmodified.
+ $re =~ s{(\[:\w+:\])|(\\)?([\[\]]|\\\z)}{
+ defined $1 ? $1 : defined $2 ? "$2$3" : "\\$3"
+ }ge;
+ eval {
+ # disable the warnings here, since they will trigger later
+ # when used, and we only want them to appear once per call,
+ # but every time the same pattern is used.
+ no warnings 'regexp';
+ $re = $subst{$patn} = qr{[$re]};
+ 1;
+ } or Carp::croak("uri_escape: $@");
+ }
+ }
+ else {
+ $re = $Unsafe{RFC3986};
}
+ $text =~ s/($re)/$escapes{$1} || _fail_hi($1)/ge;
$text;
}
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm
index f2637a028b..bc775a53bc 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm
@@ -91,7 +91,7 @@ use warnings;
use Exporter 5.57 'import';
our @EXPORT_OK = qw(uf_uri uf_uristr uf_url uf_urlstr);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
our ($MY_COUNTRY, $DEBUG);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm
index fd185a9e49..f62c77bdd5 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm
@@ -8,7 +8,7 @@ use URI ();
use overload '""' => sub { shift->as_string };
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub new {
my($class, $uri, $scheme) = @_;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm
index c7ff25ed9f..de3c54cf18 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm
@@ -1,90 +1,8 @@
package URI::QueryParam;
-
use strict;
use warnings;
-our $VERSION = '5.10';
-
-sub URI::_query::query_param {
- my $self = shift;
- my @old = $self->query_form;
-
- if (@_ == 0) {
- # get keys
- my (%seen, $i);
- return grep !($i++ % 2 || $seen{$_}++), @old;
- }
-
- my $key = shift;
- my @i = grep $_ % 2 == 0 && $old[$_] eq $key, 0 .. $#old;
-
- if (@_) {
- my @new = @old;
- my @new_i = @i;
- my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
-
- while (@new_i > @vals) {
- splice @new, pop @new_i, 2;
- }
- if (@vals > @new_i) {
- my $i = @new_i ? $new_i[-1] + 2 : @new;
- my @splice = splice @vals, @new_i, @vals - @new_i;
-
- splice @new, $i, 0, map { $key => $_ } @splice;
- }
- if (@vals) {
- #print "SET $new_i[0]\n";
- @new[ map $_ + 1, @new_i ] = @vals;
- }
-
- $self->query_form(\@new);
- }
-
- return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef;
-}
-
-sub URI::_query::query_param_append {
- my $self = shift;
- my $key = shift;
- my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_;
- $self->query_form($self->query_form, $key => \@vals); # XXX
- return;
-}
-
-sub URI::_query::query_param_delete {
- my $self = shift;
- my $key = shift;
- my @old = $self->query_form;
- my @vals;
-
- for (my $i = @old - 2; $i >= 0; $i -= 2) {
- next if $old[$i] ne $key;
- push(@vals, (splice(@old, $i, 2))[1]);
- }
- $self->query_form(\@old) if @vals;
- return wantarray ? reverse @vals : $vals[-1];
-}
-
-sub URI::_query::query_form_hash {
- my $self = shift;
- my @old = $self->query_form;
- if (@_) {
- $self->query_form(@_ == 1 ? %{shift(@_)} : @_);
- }
- my %hash;
- while (my($k, $v) = splice(@old, 0, 2)) {
- if (exists $hash{$k}) {
- for ($hash{$k}) {
- $_ = [$_] unless ref($_) eq "ARRAY";
- push(@$_, $v);
- }
- }
- else {
- $hash{$k} = $v;
- }
- }
- return \%hash;
-}
+our $VERSION = '5.27';
1;
@@ -97,108 +15,16 @@ URI::QueryParam - Additional query methods for URIs
=head1 SYNOPSIS
use URI;
- use URI::QueryParam;
-
- $u = URI->new("", "http");
- $u->query_param(foo => 1, 2, 3);
- print $u->query; # prints foo=1&foo=2&foo=3
-
- for my $key ($u->query_param) {
- print "$key: ", join(", ", $u->query_param($key)), "\n";
- }
=head1 DESCRIPTION
-Loading the C<URI::QueryParam> module adds some extra methods to
-URIs that support query methods. These methods provide an alternative
-interface to the $u->query_form data.
-
-The query_param_* methods have deliberately been made identical to the
-interface of the corresponding C<CGI.pm> methods.
-
-The following additional methods are made available:
-
-=over
-
-=item @keys = $u->query_param
-
-=item @values = $u->query_param( $key )
-
-=item $first_value = $u->query_param( $key )
-
-=item $u->query_param( $key, $value,... )
-
-If $u->query_param is called with no arguments, it returns all the
-distinct parameter keys of the URI. In a scalar context it returns the
-number of distinct keys.
-
-When a $key argument is given, the method returns the parameter values with the
-given key. In a scalar context, only the first parameter value is
-returned.
-
-If additional arguments are given, they are used to update successive
-parameters with the given key. If any of the values provided are
-array references, then the array is dereferenced to get the actual
-values.
-
-Please note that you can supply multiple values to this method, but you cannot
-supply multiple keys.
-
-Do this:
-
- $uri->query_param( widget_id => 1, 5, 9 );
-
-Do NOT do this:
-
- $uri->query_param( widget_id => 1, frobnicator_id => 99 );
-
-=item $u->query_param_append($key, $value,...)
-
-Adds new parameters with the given
-key without touching any old parameters with the same key. It
-can be explained as a more efficient version of:
-
- $u->query_param($key,
- $u->query_param($key),
- $value,...);
-
-One difference is that this expression would return the old values
-of $key, whereas the query_param_append() method does not.
-
-=item @values = $u->query_param_delete($key)
-
-=item $first_value = $u->query_param_delete($key)
-
-Deletes all key/value pairs with the given key.
-The old values are returned. In a scalar context, only the first value
-is returned.
-
-Using the query_param_delete() method is slightly more efficient than
-the equivalent:
-
- $u->query_param($key, []);
-
-=item $hashref = $u->query_form_hash
-
-=item $u->query_form_hash( \%new_form )
-
-Returns a reference to a hash that represents the
-query form's key/value pairs. If a key occurs multiple times, then the hash
-value becomes an array reference.
-
-Note that sequence information is lost. This means that:
-
- $u->query_form_hash($u->query_form_hash);
-
-is not necessarily a no-op, as it may reorder the key/value pairs.
-The values returned by the query_param() method should stay the same
-though.
-
-=back
-
-=head1 SEE ALSO
-
-L<URI>, L<CGI>
+C<URI::QueryParam> used to provide the
+L<< query_form_hash|URI/$hashref = $u->query_form_hash >>,
+L<< query_param|URI/@keys = $u->query_param >>
+L<< query_param_append|URI/$u->query_param_append($key, $value,...) >>, and
+L<< query_param_delete|URI/ @values = $u->query_param_delete($key) >> methods
+on L<URI> objects. These methods have been merged into L<URI> itself, so this
+module is now a no-op.
=head1 COPYRIGHT
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm
index b31d8281ce..9ac3b15eaf 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm
@@ -3,7 +3,7 @@ package URI::Split;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use Exporter 5.57 'import';
our @EXPORT_OK = qw(uri_split uri_join);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm
index 9591e9e76a..1b88311af4 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm
@@ -5,7 +5,7 @@ use warnings;
use parent 'URI::WithBase';
-our $VERSION = '5.10';
+our $VERSION = '5.27';
# Provide as much as possible of the old URI::URL interface for backwards
# compatibility...
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm
index 76c331b0af..29e76d4b2f 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm
@@ -6,7 +6,7 @@ use warnings;
use URI ();
use Scalar::Util qw(blessed);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use overload '""' => "as_string", fallback => 1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm
index bc44f4a059..7225450b19 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm
@@ -5,6 +5,6 @@ use warnings;
use parent 'URI::_generic';
-our $VERSION = '5.10';
+our $VERSION = '5.27';
1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm
index 9ff33b2142..50bc7d27df 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm
@@ -8,13 +8,33 @@ use parent qw(URI URI::_query);
use URI::Escape qw(uri_unescape);
use Carp ();
-our $VERSION = '5.10';
+our $VERSION = '5.27';
-my $ACHAR = $URI::uric; $ACHAR =~ s,\\[/?],,g;
-my $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g;
+my $ACHAR = URI::HAS_RESERVED_SQUARE_BRACKETS ? $URI::uric : $URI::uric4host; $ACHAR =~ s,\\[/?],,g;
+my $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g;
sub _no_scheme_ok { 1 }
+our $IPv6_re;
+
+sub _looks_like_raw_ip6_address {
+ my $addr = shift;
+
+ if ( !$IPv6_re ) { #-- lazy / runs once / use Regexp::IPv6 if installed
+ eval {
+ require Regexp::IPv6;
+ Regexp::IPv6->import( qw($IPv6_re) );
+ 1;
+ } || do { $IPv6_re = qr/[:0-9a-f]{3,}/; }; #-- fallback: unambitious guess
+ }
+
+ return 0 unless $addr;
+ return 0 if $addr =~ tr/:/:/ < 2; #-- fallback must not create false positive for IPv4:Port = 0:0
+ return 1 if $addr =~ /^$IPv6_re$/i;
+ return 0;
+}
+
+
sub authority
{
my $self = shift;
@@ -26,6 +46,13 @@ sub authority
my $rest = $3;
if (defined $auth) {
$auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego;
+ if ( my ($user, $host) = $auth =~ /^(.*@)?([^@]+)$/ ) { #-- special escape userinfo part
+ $user ||= '';
+ $user =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego;
+ $user =~ s/%40$/\@/; # recover final '@'
+ $host = "[$host]" if _looks_like_raw_ip6_address( $host );
+ $auth = $user . $host;
+ }
utf8::downgrade($auth);
$$self .= "//$auth";
}
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm
index 4292d3e982..f36e937983 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm
@@ -9,7 +9,7 @@ use warnings;
use URI::_punycode qw(decode_punycode encode_punycode);
use Carp qw(croak);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
BEGIN {
*URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS = "$]" < 5.008_003
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm
index 43193b4c9d..d2b943a79d 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm
@@ -7,7 +7,7 @@ package URI::_ldap;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use URI::Escape qw(uri_unescape);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm
index c3d0583ccc..e930bf0886 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm
@@ -5,7 +5,7 @@ use warnings;
use parent qw(URI::_server URI::_userpass);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
# Generic terminal logins. This is used as a base class for 'telnet',
# 'tn3270', and 'rlogin' URL schemes.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm
index eeb3662e1f..697c1b7bf6 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm
@@ -3,7 +3,7 @@ package URI::_punycode;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use Exporter 'import';
our @EXPORT = qw(encode_punycode decode_punycode);
@@ -25,7 +25,7 @@ my $BasicRE = qr/[\x00-\x7f]/;
sub _croak { require Carp; Carp::croak(@_); }
-sub digit_value {
+sub _digit_value {
my $code = shift;
return ord($code) - ord("A") if $code =~ /[A-Z]/;
return ord($code) - ord("a") if $code =~ /[a-z]/;
@@ -33,14 +33,14 @@ sub digit_value {
return;
}
-sub code_point {
+sub _code_point {
my $digit = shift;
return $digit + ord('a') if 0 <= $digit && $digit <= 25;
return $digit + ord('0') - 26 if 26 <= $digit && $digit <= 36;
die 'NOT COME HERE';
}
-sub adapt {
+sub _adapt {
my($delta, $numpoints, $firsttime) = @_;
$delta = $firsttime ? $delta / DAMP : $delta / 2;
$delta += $delta / $numpoints;
@@ -71,7 +71,7 @@ sub decode_punycode {
LOOP:
for (my $k = BASE; 1; $k += BASE) {
my $cp = substr($code, 0, 1, '');
- my $digit = digit_value($cp);
+ my $digit = _digit_value($cp);
defined $digit or return _croak("invalid punycode input");
$i += $digit * $w;
my $t = ($k <= $bias) ? TMIN
@@ -79,7 +79,7 @@ sub decode_punycode {
last LOOP if $digit < $t;
$w *= (BASE - $t);
}
- $bias = adapt($i - $oldi, @output + 1, $oldi == 0);
+ $bias = _adapt($i - $oldi, @output + 1, $oldi == 0);
warn "bias becomes $bias" if $DEBUG;
$n += $i / (@output + 1);
$i = $i % (@output + 1);
@@ -106,7 +106,7 @@ sub encode_punycode {
warn "basic codepoints: (@output)" if $DEBUG;
while ($h < @input) {
- my $m = min(grep { $_ >= $n } map ord, @input);
+ my $m = _min(grep { $_ >= $n } map ord, @input);
warn sprintf "next code point to insert is %04x", $m if $DEBUG;
$delta += ($m - $n) * ($h + 1);
$n = $m;
@@ -120,12 +120,12 @@ sub encode_punycode {
my $t = ($k <= $bias) ? TMIN :
($k >= $bias + TMAX) ? TMAX : $k - $bias;
last LOOP if $q < $t;
- my $cp = code_point($t + (($q - $t) % (BASE - $t)));
+ my $cp = _code_point($t + (($q - $t) % (BASE - $t)));
push @output, chr($cp);
$q = ($q - $t) / (BASE - $t);
}
- push @output, chr(code_point($q));
- $bias = adapt($delta, $h + 1, $h == $b);
+ push @output, chr(_code_point($q));
+ $bias = _adapt($delta, $h + 1, $h == $b);
warn "bias becomes $bias" if $DEBUG;
$delta = 0;
$h++;
@@ -137,7 +137,7 @@ sub encode_punycode {
return join '', @output;
}
-sub min {
+sub _min {
my $min = shift;
for (@_) { $min = $_ if $_ <= $min }
return $min;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm
index b9b70c491d..f39f35749e 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm
@@ -6,7 +6,7 @@ use warnings;
use URI ();
use URI::Escape qw(uri_unescape);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub query
{
@@ -51,10 +51,14 @@ sub query_form {
$key =~ s/ /+/g;
$vals = [ref($vals) eq "ARRAY" ? @$vals : $vals];
for my $val (@$vals) {
- $val = '' unless defined $val;
- $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
- $val =~ s/ /+/g;
- push(@query, "$key=$val");
+ if (defined $val) {
+ $val =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
+ $val =~ s/ /+/g;
+ push(@query, "$key=$val");
+ }
+ else {
+ push(@query, $key);
+ }
}
}
if (@query) {
@@ -70,8 +74,8 @@ sub query_form {
}
return if !defined($old) || !length($old) || !defined(wantarray);
return unless $old =~ /=/; # not a form
- map { s/\+/ /g; uri_unescape($_) }
- map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
+ map { ( defined ) ? do { s/\+/ /g; uri_unescape($_) } : undef }
+ map { /=/ ? split(/=/, $_, 2) : ($_ => undef)} split(/[&;]/, $old);
}
# Handle ...?dog+bones type of query
@@ -94,4 +98,85 @@ sub query_keywords
# Some URI::URL compatibility stuff
sub equery { goto &query }
+sub query_param {
+ my $self = shift;
+ my @old = $self->query_form;
+
+ if (@_ == 0) {
+ # get keys
+ my (%seen, $i);
+ return grep !($i++ % 2 || $seen{$_}++), @old;
+ }
+
+ my $key = shift;
+ my @i = grep $_ % 2 == 0 && $old[$_] eq $key, 0 .. $#old;
+
+ if (@_) {
+ my @new = @old;
+ my @new_i = @i;
+ my @vals = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
+
+ while (@new_i > @vals) {
+ splice @new, pop @new_i, 2;
+ }
+ if (@vals > @new_i) {
+ my $i = @new_i ? $new_i[-1] + 2 : @new;
+ my @splice = splice @vals, @new_i, @vals - @new_i;
+
+ splice @new, $i, 0, map { $key => $_ } @splice;
+ }
+ if (@vals) {
+ #print "SET $new_i[0]\n";
+ @new[ map $_ + 1, @new_i ] = @vals;
+ }
+
+ $self->query_form(\@new);
+ }
+
+ return wantarray ? @old[map $_+1, @i] : @i ? $old[$i[0]+1] : undef;
+}
+
+sub query_param_append {
+ my $self = shift;
+ my $key = shift;
+ my @vals = map { ref $_ eq 'ARRAY' ? @$_ : $_ } @_;
+ $self->query_form($self->query_form, $key => \@vals); # XXX
+ return;
+}
+
+sub query_param_delete {
+ my $self = shift;
+ my $key = shift;
+ my @old = $self->query_form;
+ my @vals;
+
+ for (my $i = @old - 2; $i >= 0; $i -= 2) {
+ next if $old[$i] ne $key;
+ push(@vals, (splice(@old, $i, 2))[1]);
+ }
+ $self->query_form(\@old) if @vals;
+ return wantarray ? reverse @vals : $vals[-1];
+}
+
+sub query_form_hash {
+ my $self = shift;
+ my @old = $self->query_form;
+ if (@_) {
+ $self->query_form(@_ == 1 ? %{shift(@_)} : @_);
+ }
+ my %hash;
+ while (my($k, $v) = splice(@old, 0, 2)) {
+ if (exists $hash{$k}) {
+ for ($hash{$k}) {
+ $_ = [$_] unless ref($_) eq "ARRAY";
+ push(@$_, $v);
+ }
+ }
+ else {
+ $hash{$k} = $v;
+ }
+ }
+ return \%hash;
+}
+
1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm
index 364ca4857d..948e07b602 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm
@@ -11,7 +11,7 @@ use URI::Escape qw(uri_unescape);
use overload '""' => sub { $_[0]->[0] },
fallback => 1;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub new
{
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm
index fec55a4fe0..baaf8457bb 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm
@@ -7,7 +7,7 @@ use parent 'URI::_generic';
use URI::Escape qw(uri_unescape);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub _uric_escape {
my($class, $str) = @_;
@@ -23,7 +23,8 @@ sub _uric_escape {
}
sub _host_escape {
- return unless $_[0] =~ /[^$URI::uric]/;
+ return if URI::HAS_RESERVED_SQUARE_BRACKETS and $_[0] !~ /[^$URI::uric]/;
+ return if !URI::HAS_RESERVED_SQUARE_BRACKETS and $_[0] !~ /[^$URI::uric4host]/;
eval {
require URI::_idna;
$_[0] = URI::_idna::encode($_[0]);
@@ -59,8 +60,8 @@ sub userinfo
$new =~ s/.*@//; # remove old stuff
my $ui = shift;
if (defined $ui) {
- $ui =~ s/@/%40/g; # protect @
- $new = "$ui\@$new";
+ $ui =~ s/([^$URI::uric4user])/ URI::Escape::escape_char($1)/ego;
+ $new = "$ui\@$new";
}
$self->authority($new);
}
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm
index acf571783a..5fd36a78a2 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm
@@ -5,7 +5,7 @@ use warnings;
use URI::Escape qw(uri_unescape);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub user
{
@@ -39,8 +39,8 @@ sub password
my $user = defined($info) ? $info : "";
$user =~ s/:.*//;
- if (!defined($new) && !length($user)) {
- $self->userinfo(undef);
+ if (!defined($new)) {
+ $self->userinfo(length $user ? $user : undef);
} else {
$new = "" unless defined($new);
$new =~ s/%/%25/g;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm
index 666ef38afb..2b87018b46 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm
@@ -5,7 +5,7 @@ use warnings;
use parent 'URI';
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use MIME::Base64 qw(decode_base64 encode_base64);
use URI::Escape qw(uri_unescape);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm
index c9973ecce9..51f6431e8d 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm
@@ -4,7 +4,7 @@ use strict;
use warnings;
use parent 'URI::_generic';
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use URI::Escape qw(uri_unescape);
@@ -113,13 +113,13 @@ URI::file - URI that maps to local file names
=head1 SYNOPSIS
use URI::file;
-
+
$u1 = URI->new("file:/foo/bar");
$u2 = URI->new("foo/bar", "file");
-
+
$u3 = URI::file->new($path);
$u4 = URI::file->new("c:\\windows\\", "win32");
-
+
$u1->file;
$u1->file("mac");
@@ -127,10 +127,8 @@ URI::file - URI that maps to local file names
The C<URI::file> class supports C<URI> objects belonging to the I<file>
URI scheme. This scheme allows us to map the conventional file names
-found on various computer systems to the URI name space. An old
-specification of the I<file> URI scheme is found in RFC 1738. Some
-older background information is also in RFC 1630. There are no newer
-specifications as far as I know.
+found on various computer systems to the URI name space,
+see L<RFC 8089|https://www.rfc-editor.org/rfc/rfc8089.html>.
If you simply want to construct I<file> URI objects from URI strings,
use the normal C<URI> constructor. If you want to construct I<file>
@@ -200,8 +198,9 @@ suitable for the local system:
Most computer systems today have hierarchically organized file systems.
Mapping the names used in these systems to the generic URI syntax
allows us to work with relative file URIs that behave as they should
-when resolved using the generic algorithm for URIs (specified in RFC
-2396). Mapping a file name to the generic URI syntax involves mapping
+when resolved using the generic algorithm for URIs (specified in L<RFC
+3986|https://www.rfc-editor.org/rfc/rfc3986.html>).
+Mapping a file name to the generic URI syntax involves mapping
the path separator character to "/" and encoding any reserved
characters that appear in the path segments of the file name. If
path segments consisting of the strings "." or ".." have a
@@ -301,11 +300,11 @@ If there is no mapping then the "Unix" implementation is used.
=item $URI::file::DEFAULT_AUTHORITY
-This determine what "authority" string to include in absolute file
+This determines what "authority" string to include in absolute file
URIs. It defaults to "". If you prefer verbose URIs you might set it
to be "localhost".
-Setting this value to C<undef> force behaviour compatible to URI v1.31
+Setting this value to C<undef> forces behaviour compatible to URI v1.31
and earlier. In this mode host names in UNC paths and drive letters
are mapped to the authority component on Windows, while we produce
authority-less URIs on Unix.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm
index 5192f33a14..993e6946d5 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm
@@ -5,7 +5,7 @@ use warnings;
use URI::Escape ();
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub new
{
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm
index 521c3a05a4..98b651666e 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm
@@ -5,7 +5,7 @@ use warnings;
use parent 'URI::file::Win32';
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub fix_path
{
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm
index ee7bf57877..561982e93b 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm
@@ -7,7 +7,7 @@ use parent 'URI::file::Base';
use URI::Escape qw(uri_unescape);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub _file_extract_path
{
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm
index 14ec91570b..357e9a43f0 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm
@@ -5,7 +5,7 @@ use warnings;
use parent 'URI::file::Win32';
-our $VERSION = '5.10';
+our $VERSION = '5.27';
# The Win32 version translates k:/foo to file://k:/foo (?!)
# We add an empty host
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm
index cb47809898..7c6463e2ff 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm
@@ -5,7 +5,7 @@ use warnings;
use parent 'URI::file::Unix';
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub _file_extract_path
{
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm
index fa226f7765..0c35e91d81 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm
@@ -7,7 +7,7 @@ use parent 'URI::file::Base';
use URI::Escape qw(uri_unescape);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub _file_extract_path
{
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm
index bc1b373b4e..4a7f0f3bef 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm
@@ -7,7 +7,7 @@ use parent 'URI::file::Base';
use URI::Escape qw(uri_unescape);
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub _file_extract_authority
{
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm
index a6c12df271..d0ba16f754 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm
@@ -3,7 +3,7 @@ package URI::ftp;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent qw(URI::_server URI::_userpass);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm
new file mode 100755
index 0000000000..da2b9517ad
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/geo.pm
@@ -0,0 +1,418 @@
+package URI::geo;
+
+use warnings;
+use strict;
+
+use Carp;
+use URI::Split qw( uri_split uri_join );
+
+use base qw( URI );
+
+our $VERSION = '5.27';
+
+sub _MINIMUM_LATITUDE { return -90 }
+sub _MAXIMUM_LATITUDE { return 90 }
+sub _MINIMUM_LONGITUDE { return -180 }
+sub _MAXIMUM_LONGITUDE { return 180 }
+sub _MAX_POINTY_PARAMETERS { return 3 }
+
+sub _can {
+ my ($can_pt, @keys) = @_;
+ for my $key (@keys) {
+ return $key if $can_pt->can($key);
+ }
+ return;
+}
+
+sub _has {
+ my ($has_pt, @keys) = @_;
+ for my $key (@keys) {
+ return $key if exists $has_pt->{$key};
+ }
+ return;
+}
+
+# Try hard to extract location information from something. We handle lat,
+# lon, alt as scalars, arrays containing lat, lon, alt, hashes with
+# suitably named keys and objects with suitably named methods.
+
+sub _location_of_pointy_thing {
+ my ($class, @parameters) = @_;
+
+ my @lat = qw( lat latitude );
+ my @lon = qw( lon long longitude lng );
+ my @ele = qw( ele alt elevation altitude );
+
+ if (ref $parameters[0]) {
+ my $pt = shift @parameters;
+
+ if (@parameters) {
+ croak q[Too many arguments];
+ }
+
+ if (eval { $pt->can('can') }) {
+ for my $m (qw( location latlong )) {
+ return $pt->$m() if _can($pt, $m);
+ }
+
+ my $latk = _can($pt, @lat);
+ my $lonk = _can($pt, @lon);
+ my $elek = _can($pt, @ele);
+
+ if (defined $latk && defined $lonk) {
+ return $pt->$latk(), $pt->$lonk(),
+ defined $elek ? $pt->$elek() : undef;
+ }
+ }
+ elsif ('ARRAY' eq ref $pt) {
+ return $class->_location_of_pointy_thing(@{$pt});
+ }
+ elsif ('HASH' eq ref $pt) {
+
+ my $latk = _has($pt, @lat);
+ my $lonk = _has($pt, @lon);
+ my $elek = _has($pt, @ele);
+
+ if (defined $latk && defined $lonk) {
+ return $pt->{$latk}, $pt->{$lonk},
+ defined $elek ? $pt->{$elek} : undef;
+ }
+ }
+
+ croak q[Don't know how to convert point];
+ }
+ else {
+ croak q[Need lat, lon or lat, lon, alt]
+ if @parameters < 2 || @parameters > _MAX_POINTY_PARAMETERS();
+ return my ($lat, $lon, $alt) = @parameters;
+ }
+}
+
+sub _num {
+ my ($class, $n) = @_;
+ if (!defined $n) {
+ return q[];
+ }
+ (my $rep = sprintf '%f', $n) =~ s/[.]0*$//smx;
+ return $rep;
+}
+
+sub new {
+ my ($self, @parameters) = @_;
+ my $class = ref $self || $self;
+ my $uri = uri_join 'geo', undef, $class->_path(@parameters);
+ return bless \$uri, $class;
+}
+
+sub _init {
+ my ($class, $uri, $scheme) = @_;
+
+ my $self = $class->SUPER::_init($uri, $scheme);
+
+ # Normalise at poles.
+ my $lat = $self->latitude;
+ if ($lat == _MAXIMUM_LATITUDE() || $lat == _MINIMUM_LATITUDE()) {
+ $self->longitude(0);
+ }
+ return $self;
+}
+
+sub location {
+ my ($self, @parameters) = @_;
+
+ if (@parameters) {
+ my ($lat, $lon, $alt) = @parameters;
+ return $self->latitude($lat)->longitude($lon)->altitude($alt);
+ }
+
+ return $self->latitude, $self->longitude, $self->altitude;
+}
+
+sub latitude {
+ my ($self, @parameters) = @_;
+ return $self->field('latitude', @parameters);
+}
+
+sub longitude {
+ my ($self, @parameters) = @_;
+ return $self->field('longitude', @parameters);
+}
+
+sub altitude {
+ my ($self, @parameters) = @_;
+ return $self->field('altitude', @parameters);
+}
+
+sub crs {
+ my ($self, @parameters) = @_;
+ return $self->field('crs', @parameters);
+}
+
+sub uncertainty {
+ my ($self, @parameters) = @_;
+ return $self->field('uncertainty', @parameters);
+}
+
+sub field {
+ my ($self, $name, @remainder) = @_;
+ my ($scheme, $auth, $v, $query, $frag) = $self->_parse;
+
+ if (!exists $v->{$name}) {
+ croak "No such field: $name";
+ }
+ if (!@remainder) {
+ return $v->{$name};
+ }
+ $v->{$name} = shift @remainder;
+ ${$self} = uri_join $scheme, $auth, $self->_format($v), $query, $frag;
+ return $self;
+}
+
+{
+ my $pnum = qr{\d+(?:[.]\d+)?}smx;
+ my $num = qr{-?$pnum}smx;
+ my $crsp = qr{(?:;crs=(\w+))}smx;
+ my $uncp = qr{(?:;u=($pnum))}smx;
+ my $parm = qr{(?:;\w+=[^;]*)+}smx;
+
+ sub _parse {
+ my $self = shift;
+ my ($scheme, $auth, $path, $query, $frag) = uri_split ${$self};
+
+ $path =~ m{^ ($num), ($num) (?: , ($num) ) ?
+ (?: $crsp ) ?
+ (?: $uncp ) ?
+ ( $parm ) ?
+ $}smx or croak 'Badly formed geo uri';
+
+ # No named captures before 5.10.0
+ return $scheme, $auth,
+ {
+ latitude => $1,
+ longitude => $2,
+ altitude => $3,
+ crs => $4,
+ uncertainty => $5,
+ parameters => (defined $6 ? substr $6, 1 : undef),
+ },
+ $query, $frag;
+ }
+}
+
+sub _format {
+ my ($class, $v) = @_;
+ return join q[;],
+ (
+ join q[,],
+ map { $class->_num($_) } @{$v}{'latitude', 'longitude'},
+ (defined $v->{altitude} ? ($v->{altitude}) : ())
+ ),
+ (defined $v->{crs} ? ('crs=' . $class->_num($v->{crs})) : ()),
+ (
+ defined $v->{uncertainty}
+ ? ('u=' . $class->_num($v->{uncertainty}))
+ : ()), (defined $v->{parameters} ? ($v->{parameters}) : ());
+}
+
+sub _path {
+ my ($class, @parameters) = @_;
+ my ($lat, $lon, $alt) = $class->_location_of_pointy_thing(@parameters);
+ croak 'Latitude out of range'
+ if $lat < _MINIMUM_LATITUDE() || $lat > _MAXIMUM_LATITUDE();
+ croak 'Longitude out of range'
+ if $lon < _MINIMUM_LONGITUDE() || $lon > _MAXIMUM_LONGITUDE();
+ if ($lat == _MINIMUM_LATITUDE() || $lat == _MAXIMUM_LATITUDE()) {
+ $lat = 0;
+ }
+ return $class->_format(
+ {latitude => $lat, longitude => $lon, altitude => $alt});
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+URI::geo - URI scheme for geo Identifiers
+
+=head1 SYNOPSIS
+
+ use URI;
+
+ # Geo URI from textual uri
+ my $guri = URI->new( 'geo:54.786989,-2.344214' );
+
+ # From coordinates
+ my $guri = URI::geo->new( 54.786989, -2.344214 );
+
+ # Decode
+ my ( $lat, $lon, $alt ) = $guri->location;
+ my $latitude = $guri->latitude;
+
+ # Update
+ $guri->location( 55, -1 );
+ $guri->longitude( -43.23 );
+
+=head1 DESCRIPTION
+
+From L<http://geouri.org/>:
+
+ More and more protocols and data formats are being extended by methods
+ to add geographic information. However, all of those options are tied
+ to that specific protocol or data format.
+
+ A dedicated Uniform Resource Identifier (URI) scheme for geographic
+ locations would be independent from any protocol, usable by any
+ software/data format that can handle generich URIs. Like a "mailto:"
+ URI launches your favourite mail application today, a "geo:" URI could
+ soon launch your favourite mapping service, or queue that location for
+ a navigation device.
+
+=head1 SUBROUTINES/METHODS
+
+=head2 C<< new >>
+
+Create a new URI::geo. The arguments should be either
+
+=over
+
+=item * latitude, longitude and optionally altitude
+
+=item * a reference to an array containing lat, lon, alt
+
+=item * a reference to a hash with suitably named keys or
+
+=item * a reference to an object with suitably named accessors
+
+=back
+
+To maximize the likelihood that you can pass in some object that
+represents a geographical location and have URI::geo do the right thing
+we try a number of different accessor names.
+
+If the object has a C<latlong> method (e.g. L<Geo::Point>) we'll use that.
+If there's a C<location> method we call that. Otherwise we look for
+accessors called C<lat>, C<latitude>, C<lon>, C<long>, C<longitude>,
+C<ele>, C<alt>, C<elevation> or C<altitude> and use them.
+
+Often if you have an object or hash reference that represents a point
+you can pass it directly to C<new>; so for example this will work:
+
+ use URI::geo;
+ use Geo::Point;
+
+ my $pt = Geo::Point->latlong( 48.208333, 16.372778 );
+ my $guri = URI::geo->new( $pt );
+
+As will this:
+
+ my $guri = URI::geo->new( { lat => 55, lon => -1 } );
+
+and this:
+
+ my $guri = URI::geo->new( 55, -1 );
+
+Note that you can also create a new C<URI::geo> by passing a Geo URI to
+C<URI::new>:
+
+ use URI;
+
+ my $guri = URI->new( 'geo:55,-1' );
+
+=head2 C<location>
+
+Get or set the location of this geo URI.
+
+ my ( $lat, $lon, $alt ) = $guri->location;
+ $guri->location( 55.3, -3.7, 120 );
+
+When setting the location it is possible to pass any of the argument
+types that can be passed to C<new>.
+
+=head2 C<latitude>
+
+Get or set the latitude of this geo URI.
+
+=head2 C<longitude>
+
+Get or set the longitude of this geo URI.
+
+=head2 C<altitude>
+
+Get or set the L<altitude|https://en.wikipedia.org/wiki/Geo_URI_scheme#Altitude> of this geo URI. To delete the altitude set it to C<undef>.
+
+=head2 C<crs>
+
+Get or set the L<Coordinate Reference System|https://en.wikipedia.org/wiki/Geo_URI_scheme#Coordinate_reference_systems> of this geo URI. To delete the CRS set it to C<undef>.
+
+=head2 C<uncertainty>
+
+Get or set the L<uncertainty|https://en.wikipedia.org/wiki/Geo_URI_scheme#Uncertainty> of this geo URI. To delete the uncertainty set it to C<undef>.
+
+=head2 C<field>
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+URI::geo requires no configuration files or environment variables.
+
+=head1 DEPENDENCIES
+
+L<URI>
+
+=head1 DIAGNOSTICS
+
+=over
+
+=item C<< Too many arguments >>
+
+The L<new|/new> method can only accept three parameters; latitude, longitude and altitude.
+
+=item C<< Don't know how to convert point >>
+
+The L<new|/new> method doesn't know how to convert the supplied parameters into a URI::geo object.
+
+=item C<< Need lat, lon or lat, lon, alt >>
+
+The L<new|/new> method needs two (latitude and longitude) or three (latitude, longitude and altitude) parameters in a list. Any less or more than this is an error.
+
+=item C<< No such field: %s >>
+
+This field is not a known field for the L<URI::geo|URI::geo> object.
+
+=item C<< Badly formed geo uri >>
+
+The L<URI|URI> cannot be parsed as a URI
+
+=item C<< Badly formed geo uri >>
+
+The L<URI|URI> cannot be parsed as a URI
+
+=item C<< Latitude out of range >>
+
+Latitude may only be from -90 to +90
+
+=item C<< Longitude out of range >>
+
+Longitude may only be from -180 to +180
+
+=back
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+=head1 BUGS AND LIMITATIONS
+
+To report a bug, or view the current list of bugs, please visit L<https://github.com/libwww-perl/URI/issues>
+
+=head1 AUTHOR
+
+Andy Armstrong C<< <andy@hexten.net> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright (c) 2009, Andy Armstrong C<< <andy@hexten.net> >>.
+
+This module is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself. See L<perlartistic>.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm
index febd95c0ba..0ab8513eca 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm
@@ -3,7 +3,7 @@ package URI::gopher; # <draft-murali-url-gopher>, Dec 4, 1996
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::_server';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm
index 50a09f0989..6f970bb034 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm
@@ -3,7 +3,7 @@ package URI::http;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::_server';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm
index e3283e57c0..9b8c4c6b6c 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm
@@ -3,7 +3,7 @@ package URI::https;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::http';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icap.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icap.pm
new file mode 100755
index 0000000000..674078dffe
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icap.pm
@@ -0,0 +1,76 @@
+package URI::icap;
+
+use strict;
+use warnings;
+use base qw(URI::http);
+
+our $VERSION = '5.27';
+
+sub default_port { return 1344 }
+
+1;
+__END__
+
+=head1 NAME
+
+URI::icap - URI scheme for ICAP Identifiers
+
+=head1 VERSION
+
+Version 5.20
+
+=head1 SYNOPSIS
+
+ use URI::icap;
+
+ my $uri = URI->new('icap://icap-proxy.example.com/');
+
+=head1 DESCRIPTION
+
+This module implements the C<icap:> URI scheme defined in L<RFC 3507|http://tools.ietf.org/html/rfc3507>, for the L<Internet Content Adaptation Protocol|https://en.wikipedia.org/wiki/Internet_Content_Adaptation_Protocol>.
+
+=head1 SUBROUTINES/METHODS
+
+This module inherits the behaviour of L<URI::http|URI::http> and overrides the L<default_port|URI#$uri->default_port> method.
+
+=head2 default_port
+
+The default port for icap servers is 1344
+
+=head1 DIAGNOSTICS
+
+See L<URI|URI>
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+See L<URI|URI#CONFIGURATION-VARIABLES> and L<URI|URI#ENVIRONMENT-VARIABLES>
+
+=head1 DEPENDENCIES
+
+None
+
+=head1 INCOMPATIBILITIES
+
+None reported
+
+=head1 BUGS AND LIMITATIONS
+
+See L<URI|URI#BUGS>
+
+=head1 SEE ALSO
+
+L<RFC 3507|http://tools.ietf.org/html/rfc3507>
+
+=head1 AUTHOR
+
+David Dick, C<< <ddick at cpan.org> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2016 David Dick.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See L<http://dev.perl.org/licenses/> for more information.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm
new file mode 100755
index 0000000000..dd171439fe
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/icaps.pm
@@ -0,0 +1,76 @@
+package URI::icaps;
+
+use strict;
+use warnings;
+use base qw(URI::icap);
+
+our $VERSION = '5.27';
+
+sub secure { return 1 }
+
+1;
+__END__
+
+=head1 NAME
+
+URI::icaps - URI scheme for ICAPS Identifiers
+
+=head1 VERSION
+
+Version 5.20
+
+=head1 SYNOPSIS
+
+ use URI::icaps;
+
+ my $uri = URI->new('icaps://icap-proxy.example.com/');
+
+=head1 DESCRIPTION
+
+This module implements the C<icaps:> URI scheme defined in L<RFC 3507|http://tools.ietf.org/html/rfc3507>, for the L<Internet Content Adaptation Protocol|https://en.wikipedia.org/wiki/Internet_Content_Adaptation_Protocol>.
+
+=head1 SUBROUTINES/METHODS
+
+This module inherits the behaviour of L<URI::icap|URI::icap> and overrides the L<secure|URI#$uri->secure> method.
+
+=head2 secure
+
+returns 1 as icaps is a secure protocol
+
+=head1 DIAGNOSTICS
+
+See L<URI::icap|URI::icap>
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+See L<URI::icap|URI::icap>
+
+=head1 DEPENDENCIES
+
+None
+
+=head1 INCOMPATIBILITIES
+
+None reported
+
+=head1 BUGS AND LIMITATIONS
+
+See L<URI::icap|URI::icap>
+
+=head1 SEE ALSO
+
+L<RFC 3507|http://tools.ietf.org/html/rfc3507>
+
+=head1 AUTHOR
+
+David Dick, C<< <ddick at cpan.org> >>
+
+=head1 LICENSE AND COPYRIGHT
+
+Copyright 2016 David Dick.
+
+This program is free software; you can redistribute it and/or modify it
+under the terms of either: the GNU General Public License as published
+by the Free Software Foundation; or the Artistic License.
+
+See L<http://dev.perl.org/licenses/> for more information.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm
index 2977954b5a..566f22c9cd 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm
@@ -7,7 +7,7 @@ package URI::ldap;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent qw(URI::_ldap URI::_server);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm
index e3bac5a860..d792d1f020 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm
@@ -3,7 +3,7 @@ package URI::ldapi;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent qw(URI::_ldap URI::_generic);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm
index 4d58c67e38..d79f504aac 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm
@@ -3,7 +3,7 @@ package URI::ldaps;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::ldap';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm
index 5d6f241080..34215752cc 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm
@@ -3,7 +3,7 @@ package URI::mailto; # RFC 2368
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent qw(URI URI::_query);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm
index 6a41297484..dfa02a2dfe 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm
@@ -3,7 +3,7 @@ package URI::mms;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::http';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm
index 4092981be0..19e3f2271d 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm
@@ -3,7 +3,7 @@ package URI::news; # draft-gilman-news-url-01
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::_server';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm
index be276893d0..1386e9426b 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm
@@ -3,7 +3,7 @@ package URI::nntp; # draft-gilman-news-url-01
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::news';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm
index a10e99293a..d37fed6b3c 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntps.pm
@@ -3,7 +3,7 @@ package URI::nntps;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::nntp';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm
index accab911b4..0ac79d8409 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm
@@ -3,7 +3,7 @@ package URI::pop; # RFC 2384
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::_server';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm
index 049ff4a026..a89ac837e1 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm
@@ -3,7 +3,7 @@ package URI::rlogin;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::_login';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm
index 164c6b7d55..166a1d4c6a 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm
@@ -5,7 +5,7 @@ package URI::rsync; # http://rsync.samba.org/
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent qw(URI::_server URI::_userpass);
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm
index 48429f7e1a..939e625fb6 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm
@@ -3,7 +3,7 @@ package URI::rtsp;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::http';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm
index c9bc64d49d..3af9fe4825 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm
@@ -3,7 +3,7 @@ package URI::rtspu;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::rtsp';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm
index 4c9a1f38bf..1af2e368d7 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm
@@ -5,6 +5,6 @@ use warnings;
use parent 'URI::ssh';
-our $VERSION = '5.10';
+our $VERSION = '5.27';
1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm
index a6aeb858ac..f3ce0f5c09 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm
@@ -14,7 +14,7 @@ use parent qw(URI::_server URI::_userpass);
use URI::Escape ();
-our $VERSION = '5.10';
+our $VERSION = '5.27';
sub default_port { 5060 }
@@ -22,37 +22,33 @@ sub authority
{
my $self = shift;
$$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;
- my $old = $2;
+ my $start = $1;
+ my $authoritystr = $2;
+ my $rest = $3;
if (@_) {
- my $auth = shift;
- $$self = defined($1) ? $1 : "";
- my $rest = $3;
- if (defined $auth) {
- $auth =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
- $$self .= "$auth";
- }
- $$self .= $rest;
+ $authoritystr = shift;
+ $authoritystr =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
+ $$self = $start . $authoritystr . $rest;
}
- $old;
+ return $authoritystr;
}
sub params_form
{
my $self = shift;
$$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
+ my $start = $1 . $2;
my $paramstr = $3;
+ my $rest = $4;
if (@_) {
- my @args = @_;
- $$self = $1 . $2;
- my $rest = $4;
- my @new;
- for (my $i=0; $i < @args; $i += 2) {
- push(@new, "$args[$i]=$args[$i+1]");
+ my @paramarr;
+ for (my $i = 0; $i < @_; $i += 2) {
+ push(@paramarr, "$_[$i]=$_[$i+1]");
}
- $paramstr = join(";", @new);
- $$self .= ";" . $paramstr . $rest;
+ $paramstr = join(";", @paramarr);
+ $$self = $start . ";" . $paramstr . $rest;
}
$paramstr =~ s/^;//o;
return split(/[;=]/, $paramstr);
@@ -62,13 +58,13 @@ sub params
{
my $self = shift;
$$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
+ my $start = $1 . $2;
my $paramstr = $3;
+ my $rest = $4;
if (@_) {
- my $new = shift;
- $$self = $1 . $2;
- my $rest = $4;
- $$self .= $paramstr . $rest;
+ $paramstr = shift;
+ $$self = $start . ";" . $paramstr . $rest;
}
$paramstr =~ s/^;//o;
return $paramstr;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm
index 3d7c2f2d6a..df6e75bd1e 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm
@@ -3,7 +3,7 @@ package URI::sips;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::sip';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm
index e541482125..2c862f51d2 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm
@@ -3,7 +3,7 @@ package URI::snews; # draft-gilman-news-url-01
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::news';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm
index 7273c2b1a5..58340f7189 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm
@@ -3,7 +3,7 @@ package URI::ssh;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::_login';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm
index 5d81650607..92db5d2533 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm
@@ -3,7 +3,7 @@ package URI::telnet;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::_login';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm
index 53a341402e..2e9d8bc669 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm
@@ -3,7 +3,7 @@ package URI::tn3270;
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::_login';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm
index 75f3a9b646..40d4a3e323 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm
@@ -3,14 +3,13 @@ package URI::urn; # RFC 2141
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI';
use Carp qw(carp);
my %implementor;
-my %require_attempted;
sub _init {
my $class = shift;
@@ -30,13 +29,11 @@ sub _init {
$impclass = "URI::urn::$id";
no strict 'refs';
unless (@{"${impclass}::ISA"}) {
- if (not exists $require_attempted{$impclass}) {
# Try to load it
my $_old_error = $@;
eval "require $impclass";
die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
$@ = $_old_error;
- }
$impclass = "URI::urn" unless @{"${impclass}::ISA"};
}
}
@@ -44,7 +41,6 @@ sub _init {
carp("Illegal namespace identifier '$nid' for URN '$self'") if $^W;
}
$implementor{$nid} = $impclass;
-
return $impclass->_urn_init($self, $nid);
}
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm
index 4986d701f6..ee1abafad1 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm
@@ -3,7 +3,7 @@ package URI::urn::isbn; # RFC 3187
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::urn';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm
index 5ba279f68c..30f42527ea 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm
@@ -3,7 +3,7 @@ package URI::urn::oid; # RFC 2061
use strict;
use warnings;
-our $VERSION = '5.10';
+our $VERSION = '5.27';
use parent 'URI::urn';
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/.packlist
index 228fdadd04..5fa2d1a6ac 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/.packlist
@@ -1,6 +1,9 @@
-E:\tlperl\bin\cpanel_json_xs
-E:\tlperl\bin\cpanel_json_xs.bat
-E:\tlperl\site\lib\Cpanel\JSON\XS.pm
-E:\tlperl\site\lib\Cpanel\JSON\XS\Boolean.pm
-E:\tlperl\site\lib\Cpanel\JSON\XS\Type.pm
-E:\tlperl\site\lib\auto\Cpanel\JSON\XS\XS.dll
+D:\tlperl\bin\cpanel_json_xs
+D:\tlperl\bin\cpanel_json_xs.bat
+D:\tlperl\site\lib\Cpanel\JSON\XS.pm
+D:\tlperl\site\lib\Cpanel\JSON\XS\Boolean.pm
+D:\tlperl\site\lib\Cpanel\JSON\XS\Type.pm
+D:\tlperl\site\lib\auto\Cpanel\JSON\XS\XS.dll
+D:\tlperl\site\lib\auto\Cpanel\JSON\XS\XS.exp
+D:\tlperl\site\lib\auto\Cpanel\JSON\XS\XS.lib
+D:\tlperl\site\lib\auto\Cpanel\JSON\XS\XS.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.dll
index a16a14e03a..0e8cf74584 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.exp
new file mode 100755
index 0000000000..0f5d42701b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.lib
new file mode 100755
index 0000000000..a784ed604a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.pdb
new file mode 100755
index 0000000000..5b88657d7b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Date/Parse/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Date/Parse/.packlist
index 3ce2a50b44..9222d79bbb 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Date/Parse/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Date/Parse/.packlist
@@ -1,39 +1,39 @@
-E:\tlperl\site\lib\Date\Format.pm
-E:\tlperl\site\lib\Date\Language.pm
-E:\tlperl\site\lib\Date\Language\Afar.pm
-E:\tlperl\site\lib\Date\Language\Amharic.pm
-E:\tlperl\site\lib\Date\Language\Austrian.pm
-E:\tlperl\site\lib\Date\Language\Brazilian.pm
-E:\tlperl\site\lib\Date\Language\Bulgarian.pm
-E:\tlperl\site\lib\Date\Language\Chinese.pm
-E:\tlperl\site\lib\Date\Language\Chinese_GB.pm
-E:\tlperl\site\lib\Date\Language\Czech.pm
-E:\tlperl\site\lib\Date\Language\Danish.pm
-E:\tlperl\site\lib\Date\Language\Dutch.pm
-E:\tlperl\site\lib\Date\Language\English.pm
-E:\tlperl\site\lib\Date\Language\Finnish.pm
-E:\tlperl\site\lib\Date\Language\French.pm
-E:\tlperl\site\lib\Date\Language\Gedeo.pm
-E:\tlperl\site\lib\Date\Language\German.pm
-E:\tlperl\site\lib\Date\Language\Greek.pm
-E:\tlperl\site\lib\Date\Language\Hungarian.pm
-E:\tlperl\site\lib\Date\Language\Icelandic.pm
-E:\tlperl\site\lib\Date\Language\Italian.pm
-E:\tlperl\site\lib\Date\Language\Norwegian.pm
-E:\tlperl\site\lib\Date\Language\Occitan.pm
-E:\tlperl\site\lib\Date\Language\Oromo.pm
-E:\tlperl\site\lib\Date\Language\Romanian.pm
-E:\tlperl\site\lib\Date\Language\Russian.pm
-E:\tlperl\site\lib\Date\Language\Russian_cp1251.pm
-E:\tlperl\site\lib\Date\Language\Russian_koi8r.pm
-E:\tlperl\site\lib\Date\Language\Sidama.pm
-E:\tlperl\site\lib\Date\Language\Somali.pm
-E:\tlperl\site\lib\Date\Language\Spanish.pm
-E:\tlperl\site\lib\Date\Language\Swedish.pm
-E:\tlperl\site\lib\Date\Language\Tigrinya.pm
-E:\tlperl\site\lib\Date\Language\TigrinyaEritrean.pm
-E:\tlperl\site\lib\Date\Language\TigrinyaEthiopian.pm
-E:\tlperl\site\lib\Date\Language\Turkish.pm
-E:\tlperl\site\lib\Date\Parse.pm
-E:\tlperl\site\lib\TimeDate.pm
-E:\tlperl\site\lib\Time\Zone.pm
+D:\tlperl\site\lib\Date\Format.pm
+D:\tlperl\site\lib\Date\Language.pm
+D:\tlperl\site\lib\Date\Language\Afar.pm
+D:\tlperl\site\lib\Date\Language\Amharic.pm
+D:\tlperl\site\lib\Date\Language\Austrian.pm
+D:\tlperl\site\lib\Date\Language\Brazilian.pm
+D:\tlperl\site\lib\Date\Language\Bulgarian.pm
+D:\tlperl\site\lib\Date\Language\Chinese.pm
+D:\tlperl\site\lib\Date\Language\Chinese_GB.pm
+D:\tlperl\site\lib\Date\Language\Czech.pm
+D:\tlperl\site\lib\Date\Language\Danish.pm
+D:\tlperl\site\lib\Date\Language\Dutch.pm
+D:\tlperl\site\lib\Date\Language\English.pm
+D:\tlperl\site\lib\Date\Language\Finnish.pm
+D:\tlperl\site\lib\Date\Language\French.pm
+D:\tlperl\site\lib\Date\Language\Gedeo.pm
+D:\tlperl\site\lib\Date\Language\German.pm
+D:\tlperl\site\lib\Date\Language\Greek.pm
+D:\tlperl\site\lib\Date\Language\Hungarian.pm
+D:\tlperl\site\lib\Date\Language\Icelandic.pm
+D:\tlperl\site\lib\Date\Language\Italian.pm
+D:\tlperl\site\lib\Date\Language\Norwegian.pm
+D:\tlperl\site\lib\Date\Language\Occitan.pm
+D:\tlperl\site\lib\Date\Language\Oromo.pm
+D:\tlperl\site\lib\Date\Language\Romanian.pm
+D:\tlperl\site\lib\Date\Language\Russian.pm
+D:\tlperl\site\lib\Date\Language\Russian_cp1251.pm
+D:\tlperl\site\lib\Date\Language\Russian_koi8r.pm
+D:\tlperl\site\lib\Date\Language\Sidama.pm
+D:\tlperl\site\lib\Date\Language\Somali.pm
+D:\tlperl\site\lib\Date\Language\Spanish.pm
+D:\tlperl\site\lib\Date\Language\Swedish.pm
+D:\tlperl\site\lib\Date\Language\Tigrinya.pm
+D:\tlperl\site\lib\Date\Language\TigrinyaEritrean.pm
+D:\tlperl\site\lib\Date\Language\TigrinyaEthiopian.pm
+D:\tlperl\site\lib\Date\Language\Turkish.pm
+D:\tlperl\site\lib\Date\Parse.pm
+D:\tlperl\site\lib\TimeDate.pm
+D:\tlperl\site\lib\Time\Zone.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/.packlist
index 915cf6fc67..473f64cb86 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/.packlist
@@ -1,4 +1,7 @@
-E:\tlperl\bin\shasum
-E:\tlperl\bin\shasum.bat
-E:\tlperl\site\lib\Digest\SHA.pm
-E:\tlperl\site\lib\auto\Digest\SHA\SHA.dll
+D:\tlperl\bin\shasum
+D:\tlperl\bin\shasum.bat
+D:\tlperl\site\lib\Digest\SHA.pm
+D:\tlperl\site\lib\auto\Digest\SHA\SHA.dll
+D:\tlperl\site\lib\auto\Digest\SHA\SHA.exp
+D:\tlperl\site\lib\auto\Digest\SHA\SHA.lib
+D:\tlperl\site\lib\auto\Digest\SHA\SHA.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.dll
index 10baceea13..806eb23096 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.exp
new file mode 100755
index 0000000000..0807b9236e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.lib
new file mode 100755
index 0000000000..1a7cb5daa3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.pdb
new file mode 100755
index 0000000000..14c6d26556
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA/SHA.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/Locale/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/Locale/.packlist
index 9fd84edc87..ab92a81c67 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/Locale/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/Locale/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\Encode\Locale.pm
+D:\tlperl\site\lib\Encode\Locale.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/compat/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/compat/.packlist
index 60c4858995..1efa98462c 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/compat/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/compat/.packlist
@@ -1,4 +1,4 @@
-E:\tlperl\site\lib\Encode\compat.pm
-E:\tlperl\site\lib\Encode\compat\5006001.pm
-E:\tlperl\site\lib\Encode\compat\Alias.pm
-E:\tlperl\site\lib\Encode\compat\common.pm
+D:\tlperl\site\lib\Encode\compat.pm
+D:\tlperl\site\lib\Encode\compat\5006001.pm
+D:\tlperl\site\lib\Encode\compat\Alias.pm
+D:\tlperl\site\lib\Encode\compat\common.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Config/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Config/.packlist
new file mode 100755
index 0000000000..8fa504b388
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Config/.packlist
@@ -0,0 +1 @@
+D:\tlperl\site\lib\ExtUtils\Config.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Helpers/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Helpers/.packlist
new file mode 100755
index 0000000000..0fdf7f1b60
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/Helpers/.packlist
@@ -0,0 +1,4 @@
+D:\tlperl\site\lib\ExtUtils\Helpers.pm
+D:\tlperl\site\lib\ExtUtils\Helpers\Unix.pm
+D:\tlperl\site\lib\ExtUtils\Helpers\VMS.pm
+D:\tlperl\site\lib\ExtUtils\Helpers\Windows.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/InstallPaths/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/InstallPaths/.packlist
new file mode 100755
index 0000000000..e63813e67c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/ExtUtils/InstallPaths/.packlist
@@ -0,0 +1 @@
+D:\tlperl\site\lib\ExtUtils\InstallPaths.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Listing/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Listing/.packlist
index 2a9f354284..e7f9804feb 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Listing/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Listing/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\File\Listing.pm
+D:\tlperl\site\lib\File\Listing.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Which/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Which/.packlist
index 018541e49a..6071facafe 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Which/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Which/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\File\Which.pm
+D:\tlperl\site\lib\File\Which.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/.packlist
index ac6022d7d6..190d4b45d1 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/.packlist
@@ -1,8 +1,11 @@
-E:\tlperl\site\lib\HTML\Entities.pm
-E:\tlperl\site\lib\HTML\Filter.pm
-E:\tlperl\site\lib\HTML\HeadParser.pm
-E:\tlperl\site\lib\HTML\LinkExtor.pm
-E:\tlperl\site\lib\HTML\Parser.pm
-E:\tlperl\site\lib\HTML\PullParser.pm
-E:\tlperl\site\lib\HTML\TokeParser.pm
-E:\tlperl\site\lib\auto\HTML\Parser\Parser.dll
+D:\tlperl\site\lib\HTML\Entities.pm
+D:\tlperl\site\lib\HTML\Filter.pm
+D:\tlperl\site\lib\HTML\HeadParser.pm
+D:\tlperl\site\lib\HTML\LinkExtor.pm
+D:\tlperl\site\lib\HTML\Parser.pm
+D:\tlperl\site\lib\HTML\PullParser.pm
+D:\tlperl\site\lib\HTML\TokeParser.pm
+D:\tlperl\site\lib\auto\HTML\Parser\Parser.dll
+D:\tlperl\site\lib\auto\HTML\Parser\Parser.exp
+D:\tlperl\site\lib\auto\HTML\Parser\Parser.lib
+D:\tlperl\site\lib\auto\HTML\Parser\Parser.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.dll
index 4ec73a56f8..1808816ac7 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.exp
new file mode 100755
index 0000000000..68fbff39be
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.lib
new file mode 100755
index 0000000000..6969c45ab4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.pdb
new file mode 100755
index 0000000000..88624beb94
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Tagset/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Tagset/.packlist
index dab2adba68..0625f11b92 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Tagset/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Tagset/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\HTML\Tagset.pm
+D:\tlperl\site\lib\HTML\Tagset.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Cookies/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Cookies/.packlist
index 3c859961d9..82eb84f3ef 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Cookies/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Cookies/.packlist
@@ -1,3 +1,3 @@
-E:\tlperl\site\lib\HTTP\Cookies.pm
-E:\tlperl\site\lib\HTTP\Cookies\Microsoft.pm
-E:\tlperl\site\lib\HTTP\Cookies\Netscape.pm
+D:\tlperl\site\lib\HTTP\Cookies.pm
+D:\tlperl\site\lib\HTTP\Cookies\Microsoft.pm
+D:\tlperl\site\lib\HTTP\Cookies\Netscape.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Daemon/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Daemon/.packlist
index 6a3e7177e9..8133238e5e 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Daemon/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Daemon/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\HTTP\Daemon.pm
+D:\tlperl\site\lib\HTTP\Daemon.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Date/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Date/.packlist
index b1a8ab9044..78da80fb27 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Date/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Date/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\HTTP\Date.pm
+D:\tlperl\site\lib\HTTP\Date.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Message/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Message/.packlist
index 09b22f2e9a..71010b4ecc 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Message/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Message/.packlist
@@ -1,10 +1,10 @@
-E:\tlperl\site\lib\HTTP\Config.pm
-E:\tlperl\site\lib\HTTP\Headers.pm
-E:\tlperl\site\lib\HTTP\Headers\Auth.pm
-E:\tlperl\site\lib\HTTP\Headers\ETag.pm
-E:\tlperl\site\lib\HTTP\Headers\Util.pm
-E:\tlperl\site\lib\HTTP\Message.pm
-E:\tlperl\site\lib\HTTP\Request.pm
-E:\tlperl\site\lib\HTTP\Request\Common.pm
-E:\tlperl\site\lib\HTTP\Response.pm
-E:\tlperl\site\lib\HTTP\Status.pm
+D:\tlperl\site\lib\HTTP\Config.pm
+D:\tlperl\site\lib\HTTP\Headers.pm
+D:\tlperl\site\lib\HTTP\Headers\Auth.pm
+D:\tlperl\site\lib\HTTP\Headers\ETag.pm
+D:\tlperl\site\lib\HTTP\Headers\Util.pm
+D:\tlperl\site\lib\HTTP\Message.pm
+D:\tlperl\site\lib\HTTP\Request.pm
+D:\tlperl\site\lib\HTTP\Request\Common.pm
+D:\tlperl\site\lib\HTTP\Response.pm
+D:\tlperl\site\lib\HTTP\Status.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Negotiate/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Negotiate/.packlist
index 68a4a80368..b25f4bacca 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Negotiate/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Negotiate/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\HTTP\Negotiate.pm
+D:\tlperl\site\lib\HTTP\Negotiate.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/HTML/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/HTML/.packlist
index dbd37f98e3..647eea0824 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/HTML/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/HTML/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\IO\HTML.pm
+D:\tlperl\site\lib\IO\HTML.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/String/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/String/.packlist
index 6c34e39534..6e2e1666d0 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/String/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/String/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\IO\String.pm
+D:\tlperl\site\lib\IO\String.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/JSON/MaybeXS/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/JSON/MaybeXS/.packlist
index 664b0def44..1033ee8cca 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/JSON/MaybeXS/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/JSON/MaybeXS/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\JSON\MaybeXS.pm
+D:\tlperl\site\lib\JSON\MaybeXS.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/LWP/MediaTypes/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/LWP/MediaTypes/.packlist
index 4b70b3ba38..1fb51f2710 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/LWP/MediaTypes/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/LWP/MediaTypes/.packlist
@@ -1,2 +1,2 @@
-E:\tlperl\site\lib\LWP\MediaTypes.pm
-E:\tlperl\site\lib\LWP\media.types
+D:\tlperl\site\lib\LWP\MediaTypes.pm
+D:\tlperl\site\lib\LWP\media.types
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/.packlist
index 1faa7d92da..fe90d44cf9 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/.packlist
@@ -1,5 +1,8 @@
-E:\tlperl\site\lib\Math\Int64.pm
-E:\tlperl\site\lib\Math\Int64\die_on_overflow.pm
-E:\tlperl\site\lib\Math\Int64\native_if_available.pm
-E:\tlperl\site\lib\Math\UInt64.pm
-E:\tlperl\site\lib\auto\Math\Int64\Int64.dll
+D:\tlperl\site\lib\Math\Int64.pm
+D:\tlperl\site\lib\Math\Int64\die_on_overflow.pm
+D:\tlperl\site\lib\Math\Int64\native_if_available.pm
+D:\tlperl\site\lib\Math\UInt64.pm
+D:\tlperl\site\lib\auto\Math\Int64\Int64.dll
+D:\tlperl\site\lib\auto\Math\Int64\Int64.exp
+D:\tlperl\site\lib\auto\Math\Int64\Int64.lib
+D:\tlperl\site\lib\auto\Math\Int64\Int64.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.dll
index b5d3275271..4f5d4cf934 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.exp
new file mode 100755
index 0000000000..1a7d28f433
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.lib
new file mode 100755
index 0000000000..b47aed7aa0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.pdb
new file mode 100755
index 0000000000..f68db9943c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Module/Build/Tiny/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Module/Build/Tiny/.packlist
new file mode 100755
index 0000000000..96f44fbd9e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Module/Build/Tiny/.packlist
@@ -0,0 +1 @@
+D:\tlperl\site\lib\Module\Build\Tiny.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Mozilla/CA/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Mozilla/CA/.packlist
index 15939f0e26..d91e999f29 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Mozilla/CA/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Mozilla/CA/.packlist
@@ -1,3 +1,2 @@
-E:\tlperl\site\lib\Mozilla\CA.pm
-E:\tlperl\site\lib\Mozilla\CA\cacert.pem
-E:\tlperl\site\lib\Mozilla\mk-ca-bundle.pl
+D:\tlperl\site\lib\Mozilla\CA.pm
+D:\tlperl\site\lib\Mozilla\CA\cacert.pem
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Net/HTTP/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Net/HTTP/.packlist
index 002dde0575..5bad66fceb 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Net/HTTP/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Net/HTTP/.packlist
@@ -1,4 +1,4 @@
-E:\tlperl\site\lib\Net\HTTP.pm
-E:\tlperl\site\lib\Net\HTTPS.pm
-E:\tlperl\site\lib\Net\HTTP\Methods.pm
-E:\tlperl\site\lib\Net\HTTP\NB.pm
+D:\tlperl\site\lib\Net\HTTP.pm
+D:\tlperl\site\lib\Net\HTTPS.pm
+D:\tlperl\site\lib\Net\HTTP\Methods.pm
+D:\tlperl\site\lib\Net\HTTP\NB.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/.packlist
new file mode 100755
index 0000000000..4d1d3c2bef
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/.packlist
@@ -0,0 +1,5 @@
+D:\tlperl\site\lib\Socket.pm
+D:\tlperl\site\lib\auto\Socket\Socket.dll
+D:\tlperl\site\lib\auto\Socket\Socket.exp
+D:\tlperl\site\lib\auto\Socket\Socket.lib
+D:\tlperl\site\lib\auto\Socket\Socket.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.dll
new file mode 100755
index 0000000000..554f694a9c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.exp
new file mode 100755
index 0000000000..ccb9173d27
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.lib
new file mode 100755
index 0000000000..830a45002a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.pdb
new file mode 100755
index 0000000000..25c72db2d5
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Fatal/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Fatal/.packlist
index 30a11b4e85..8ad2320ded 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Fatal/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Fatal/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\Test\Fatal.pm
+D:\tlperl\site\lib\Test\Fatal.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Harness/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Harness/.packlist
new file mode 100755
index 0000000000..6efc8c0195
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Harness/.packlist
@@ -0,0 +1,52 @@
+D:\tlperl\bin\prove
+D:\tlperl\bin\prove.bat
+D:\tlperl\site\lib\App\Prove.pm
+D:\tlperl\site\lib\App\Prove\State.pm
+D:\tlperl\site\lib\App\Prove\State\Result.pm
+D:\tlperl\site\lib\App\Prove\State\Result\Test.pm
+D:\tlperl\site\lib\TAP\Base.pm
+D:\tlperl\site\lib\TAP\Formatter\Base.pm
+D:\tlperl\site\lib\TAP\Formatter\Color.pm
+D:\tlperl\site\lib\TAP\Formatter\Console.pm
+D:\tlperl\site\lib\TAP\Formatter\Console\ParallelSession.pm
+D:\tlperl\site\lib\TAP\Formatter\Console\Session.pm
+D:\tlperl\site\lib\TAP\Formatter\File.pm
+D:\tlperl\site\lib\TAP\Formatter\File\Session.pm
+D:\tlperl\site\lib\TAP\Formatter\Session.pm
+D:\tlperl\site\lib\TAP\Harness.pm
+D:\tlperl\site\lib\TAP\Harness\Beyond.pod
+D:\tlperl\site\lib\TAP\Harness\Env.pm
+D:\tlperl\site\lib\TAP\Object.pm
+D:\tlperl\site\lib\TAP\Parser.pm
+D:\tlperl\site\lib\TAP\Parser\Aggregator.pm
+D:\tlperl\site\lib\TAP\Parser\Grammar.pm
+D:\tlperl\site\lib\TAP\Parser\Iterator.pm
+D:\tlperl\site\lib\TAP\Parser\IteratorFactory.pm
+D:\tlperl\site\lib\TAP\Parser\Iterator\Array.pm
+D:\tlperl\site\lib\TAP\Parser\Iterator\Process.pm
+D:\tlperl\site\lib\TAP\Parser\Iterator\Stream.pm
+D:\tlperl\site\lib\TAP\Parser\Multiplexer.pm
+D:\tlperl\site\lib\TAP\Parser\Result.pm
+D:\tlperl\site\lib\TAP\Parser\ResultFactory.pm
+D:\tlperl\site\lib\TAP\Parser\Result\Bailout.pm
+D:\tlperl\site\lib\TAP\Parser\Result\Comment.pm
+D:\tlperl\site\lib\TAP\Parser\Result\Plan.pm
+D:\tlperl\site\lib\TAP\Parser\Result\Pragma.pm
+D:\tlperl\site\lib\TAP\Parser\Result\Test.pm
+D:\tlperl\site\lib\TAP\Parser\Result\Unknown.pm
+D:\tlperl\site\lib\TAP\Parser\Result\Version.pm
+D:\tlperl\site\lib\TAP\Parser\Result\YAML.pm
+D:\tlperl\site\lib\TAP\Parser\Scheduler.pm
+D:\tlperl\site\lib\TAP\Parser\Scheduler\Job.pm
+D:\tlperl\site\lib\TAP\Parser\Scheduler\Spinner.pm
+D:\tlperl\site\lib\TAP\Parser\Source.pm
+D:\tlperl\site\lib\TAP\Parser\SourceHandler.pm
+D:\tlperl\site\lib\TAP\Parser\SourceHandler\Executable.pm
+D:\tlperl\site\lib\TAP\Parser\SourceHandler\File.pm
+D:\tlperl\site\lib\TAP\Parser\SourceHandler\Handle.pm
+D:\tlperl\site\lib\TAP\Parser\SourceHandler\Perl.pm
+D:\tlperl\site\lib\TAP\Parser\SourceHandler\RawTAP.pm
+D:\tlperl\site\lib\TAP\Parser\YAMLish\Reader.pm
+D:\tlperl\site\lib\TAP\Parser\YAMLish\Writer.pm
+D:\tlperl\site\lib\Test\HACKING.pod
+D:\tlperl\site\lib\Test\Harness.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Needs/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Needs/.packlist
index 31bdc9e5bd..98a686ca44 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Needs/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Needs/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\Test\Needs.pm
+D:\tlperl\site\lib\Test\Needs.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/RequiresInternet/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/RequiresInternet/.packlist
index b752d66bc1..e7d736e3b5 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/RequiresInternet/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/RequiresInternet/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\Test\RequiresInternet.pm
+D:\tlperl\site\lib\Test\RequiresInternet.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Warnings/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Warnings/.packlist
new file mode 100755
index 0000000000..a03fe58a66
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Warnings/.packlist
@@ -0,0 +1 @@
+D:\tlperl\site\lib\Test\Warnings.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Try/Tiny/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Try/Tiny/.packlist
index e0b49c463a..b101b6e842 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Try/Tiny/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Try/Tiny/.packlist
@@ -1 +1 @@
-E:\tlperl\site\lib\Try\Tiny.pm
+D:\tlperl\site\lib\Try\Tiny.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/URI/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/URI/.packlist
index efacba2875..12a2b48943 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/URI/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/URI/.packlist
@@ -1,54 +1,57 @@
-E:\tlperl\site\lib\URI.pm
-E:\tlperl\site\lib\URI\Escape.pm
-E:\tlperl\site\lib\URI\Heuristic.pm
-E:\tlperl\site\lib\URI\IRI.pm
-E:\tlperl\site\lib\URI\QueryParam.pm
-E:\tlperl\site\lib\URI\Split.pm
-E:\tlperl\site\lib\URI\URL.pm
-E:\tlperl\site\lib\URI\WithBase.pm
-E:\tlperl\site\lib\URI\_foreign.pm
-E:\tlperl\site\lib\URI\_generic.pm
-E:\tlperl\site\lib\URI\_idna.pm
-E:\tlperl\site\lib\URI\_ldap.pm
-E:\tlperl\site\lib\URI\_login.pm
-E:\tlperl\site\lib\URI\_punycode.pm
-E:\tlperl\site\lib\URI\_query.pm
-E:\tlperl\site\lib\URI\_segment.pm
-E:\tlperl\site\lib\URI\_server.pm
-E:\tlperl\site\lib\URI\_userpass.pm
-E:\tlperl\site\lib\URI\data.pm
-E:\tlperl\site\lib\URI\file.pm
-E:\tlperl\site\lib\URI\file\Base.pm
-E:\tlperl\site\lib\URI\file\FAT.pm
-E:\tlperl\site\lib\URI\file\Mac.pm
-E:\tlperl\site\lib\URI\file\OS2.pm
-E:\tlperl\site\lib\URI\file\QNX.pm
-E:\tlperl\site\lib\URI\file\Unix.pm
-E:\tlperl\site\lib\URI\file\Win32.pm
-E:\tlperl\site\lib\URI\ftp.pm
-E:\tlperl\site\lib\URI\gopher.pm
-E:\tlperl\site\lib\URI\http.pm
-E:\tlperl\site\lib\URI\https.pm
-E:\tlperl\site\lib\URI\ldap.pm
-E:\tlperl\site\lib\URI\ldapi.pm
-E:\tlperl\site\lib\URI\ldaps.pm
-E:\tlperl\site\lib\URI\mailto.pm
-E:\tlperl\site\lib\URI\mms.pm
-E:\tlperl\site\lib\URI\news.pm
-E:\tlperl\site\lib\URI\nntp.pm
-E:\tlperl\site\lib\URI\nntps.pm
-E:\tlperl\site\lib\URI\pop.pm
-E:\tlperl\site\lib\URI\rlogin.pm
-E:\tlperl\site\lib\URI\rsync.pm
-E:\tlperl\site\lib\URI\rtsp.pm
-E:\tlperl\site\lib\URI\rtspu.pm
-E:\tlperl\site\lib\URI\sftp.pm
-E:\tlperl\site\lib\URI\sip.pm
-E:\tlperl\site\lib\URI\sips.pm
-E:\tlperl\site\lib\URI\snews.pm
-E:\tlperl\site\lib\URI\ssh.pm
-E:\tlperl\site\lib\URI\telnet.pm
-E:\tlperl\site\lib\URI\tn3270.pm
-E:\tlperl\site\lib\URI\urn.pm
-E:\tlperl\site\lib\URI\urn\isbn.pm
-E:\tlperl\site\lib\URI\urn\oid.pm
+D:\tlperl\site\lib\URI.pm
+D:\tlperl\site\lib\URI\Escape.pm
+D:\tlperl\site\lib\URI\Heuristic.pm
+D:\tlperl\site\lib\URI\IRI.pm
+D:\tlperl\site\lib\URI\QueryParam.pm
+D:\tlperl\site\lib\URI\Split.pm
+D:\tlperl\site\lib\URI\URL.pm
+D:\tlperl\site\lib\URI\WithBase.pm
+D:\tlperl\site\lib\URI\_foreign.pm
+D:\tlperl\site\lib\URI\_generic.pm
+D:\tlperl\site\lib\URI\_idna.pm
+D:\tlperl\site\lib\URI\_ldap.pm
+D:\tlperl\site\lib\URI\_login.pm
+D:\tlperl\site\lib\URI\_punycode.pm
+D:\tlperl\site\lib\URI\_query.pm
+D:\tlperl\site\lib\URI\_segment.pm
+D:\tlperl\site\lib\URI\_server.pm
+D:\tlperl\site\lib\URI\_userpass.pm
+D:\tlperl\site\lib\URI\data.pm
+D:\tlperl\site\lib\URI\file.pm
+D:\tlperl\site\lib\URI\file\Base.pm
+D:\tlperl\site\lib\URI\file\FAT.pm
+D:\tlperl\site\lib\URI\file\Mac.pm
+D:\tlperl\site\lib\URI\file\OS2.pm
+D:\tlperl\site\lib\URI\file\QNX.pm
+D:\tlperl\site\lib\URI\file\Unix.pm
+D:\tlperl\site\lib\URI\file\Win32.pm
+D:\tlperl\site\lib\URI\ftp.pm
+D:\tlperl\site\lib\URI\geo.pm
+D:\tlperl\site\lib\URI\gopher.pm
+D:\tlperl\site\lib\URI\http.pm
+D:\tlperl\site\lib\URI\https.pm
+D:\tlperl\site\lib\URI\icap.pm
+D:\tlperl\site\lib\URI\icaps.pm
+D:\tlperl\site\lib\URI\ldap.pm
+D:\tlperl\site\lib\URI\ldapi.pm
+D:\tlperl\site\lib\URI\ldaps.pm
+D:\tlperl\site\lib\URI\mailto.pm
+D:\tlperl\site\lib\URI\mms.pm
+D:\tlperl\site\lib\URI\news.pm
+D:\tlperl\site\lib\URI\nntp.pm
+D:\tlperl\site\lib\URI\nntps.pm
+D:\tlperl\site\lib\URI\pop.pm
+D:\tlperl\site\lib\URI\rlogin.pm
+D:\tlperl\site\lib\URI\rsync.pm
+D:\tlperl\site\lib\URI\rtsp.pm
+D:\tlperl\site\lib\URI\rtspu.pm
+D:\tlperl\site\lib\URI\sftp.pm
+D:\tlperl\site\lib\URI\sip.pm
+D:\tlperl\site\lib\URI\sips.pm
+D:\tlperl\site\lib\URI\snews.pm
+D:\tlperl\site\lib\URI\ssh.pm
+D:\tlperl\site\lib\URI\telnet.pm
+D:\tlperl\site\lib\URI\tn3270.pm
+D:\tlperl\site\lib\URI\urn.pm
+D:\tlperl\site\lib\URI\urn\isbn.pm
+D:\tlperl\site\lib\URI\urn\oid.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/WWW/RobotRules/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/WWW/RobotRules/.packlist
index 25db7235d5..5d6442b9ba 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/WWW/RobotRules/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/WWW/RobotRules/.packlist
@@ -1,2 +1,2 @@
-E:\tlperl\site\lib\WWW\RobotRules.pm
-E:\tlperl\site\lib\WWW\RobotRules\AnyDBM_File.pm
+D:\tlperl\site\lib\WWW\RobotRules.pm
+D:\tlperl\site\lib\WWW\RobotRules\AnyDBM_File.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/.packlist
index 66ecb127f4..728be00618 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/.packlist
@@ -1,7 +1,13 @@
-E:\tlperl\site\lib\Win32\API.pm
-E:\tlperl\site\lib\Win32\API\Callback.pm
-E:\tlperl\site\lib\Win32\API\Callback\IATPatch.pod
-E:\tlperl\site\lib\Win32\API\Struct.pm
-E:\tlperl\site\lib\Win32\API\Type.pm
-E:\tlperl\site\lib\auto\Win32\API\API.dll
-E:\tlperl\site\lib\auto\Win32\API\Callback\Callback.dll
+D:\tlperl\site\lib\Win32\API.pm
+D:\tlperl\site\lib\Win32\API\Callback.pm
+D:\tlperl\site\lib\Win32\API\Callback\IATPatch.pod
+D:\tlperl\site\lib\Win32\API\Struct.pm
+D:\tlperl\site\lib\Win32\API\Type.pm
+D:\tlperl\site\lib\auto\Win32\API\API.dll
+D:\tlperl\site\lib\auto\Win32\API\API.exp
+D:\tlperl\site\lib\auto\Win32\API\API.lib
+D:\tlperl\site\lib\auto\Win32\API\API.pdb
+D:\tlperl\site\lib\auto\Win32\API\Callback\Callback.dll
+D:\tlperl\site\lib\auto\Win32\API\Callback\Callback.exp
+D:\tlperl\site\lib\auto\Win32\API\Callback\Callback.lib
+D:\tlperl\site\lib\auto\Win32\API\Callback\Callback.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.dll
index 418e12b928..9dc0a2d824 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.exp
new file mode 100755
index 0000000000..7097f1dd96
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.lib
new file mode 100755
index 0000000000..bbe7ccf1a6
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.pdb
new file mode 100755
index 0000000000..1bd45bbff1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.dll
index 8b381eeaf8..4489aef6a0 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.exp
new file mode 100755
index 0000000000..6f96b0325f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.lib
new file mode 100755
index 0000000000..9831683d6d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.pdb
new file mode 100755
index 0000000000..3a741dd4a6
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/.packlist
index e1b52bc9cd..8d0736ef4e 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/.packlist
@@ -1,2 +1,5 @@
-E:\tlperl\site\lib\Win32\Console.pm
-E:\tlperl\site\lib\auto\Win32\Console\Console.dll
+D:\tlperl\site\lib\Win32\Console.pm
+D:\tlperl\site\lib\auto\Win32\Console\Console.dll
+D:\tlperl\site\lib\auto\Win32\Console\Console.exp
+D:\tlperl\site\lib\auto\Win32\Console\Console.lib
+D:\tlperl\site\lib\auto\Win32\Console\Console.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.dll
index 263b6836c9..dc29960447 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.exp
new file mode 100755
index 0000000000..3a25a882c8
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.lib
new file mode 100755
index 0000000000..28a54e76dc
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.pdb
new file mode 100755
index 0000000000..22e4d425e1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/.packlist
index 4adf837270..2219af8057 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/.packlist
@@ -1,2 +1,5 @@
-E:\tlperl\site\lib\Win32\Shortcut.pm
-E:\tlperl\site\lib\auto\Win32\Shortcut\Shortcut.dll
+D:\tlperl\site\lib\Win32\Shortcut.pm
+D:\tlperl\site\lib\auto\Win32\Shortcut\Shortcut.dll
+D:\tlperl\site\lib\auto\Win32\Shortcut\Shortcut.exp
+D:\tlperl\site\lib\auto\Win32\Shortcut\Shortcut.lib
+D:\tlperl\site\lib\auto\Win32\Shortcut\Shortcut.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.dll
index faa5713f05..838b68c4b1 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.exp
new file mode 100755
index 0000000000..1d6fe3db1f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.lib
new file mode 100755
index 0000000000..ff1422202f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.pdb
new file mode 100755
index 0000000000..782cdd8390
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/TieRegistry/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/TieRegistry/.packlist
index e9917b3014..34633f64e3 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/TieRegistry/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/TieRegistry/.packlist
@@ -1,2 +1,2 @@
-E:\tlperl\site\lib\Tie\Registry.pm
-E:\tlperl\site\lib\Win32\TieRegistry.pm
+D:\tlperl\site\lib\Tie\Registry.pm
+D:\tlperl\site\lib\Win32\TieRegistry.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/.packlist
index 2c7650348d..b300043df7 100644
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/.packlist
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/.packlist
@@ -1,3 +1,6 @@
-E:\tlperl\site\lib\Win32API\Registry.pm
-E:\tlperl\site\lib\Win32API\Registry\cRegistry.pc
-E:\tlperl\site\lib\auto\Win32API\Registry\Registry.dll
+D:\tlperl\site\lib\Win32API\Registry.pm
+D:\tlperl\site\lib\Win32API\Registry\cRegistry.pc
+D:\tlperl\site\lib\auto\Win32API\Registry\Registry.dll
+D:\tlperl\site\lib\auto\Win32API\Registry\Registry.exp
+D:\tlperl\site\lib\auto\Win32API\Registry\Registry.lib
+D:\tlperl\site\lib\auto\Win32API\Registry\Registry.pdb
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.dll
index e8a71972a8..f7577cb5fd 100755
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.dll
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.dll
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.exp b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.exp
new file mode 100755
index 0000000000..ba9ae09ba0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.exp
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.lib b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.lib
new file mode 100755
index 0000000000..4469532ac9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.lib
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.pdb b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.pdb
new file mode 100755
index 0000000000..79b57c065e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.pdb
Binary files differ
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/libwww/perl/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/libwww/perl/.packlist
deleted file mode 100644
index 2089a5a254..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/libwww/perl/.packlist
+++ /dev/null
@@ -1,33 +0,0 @@
-E:\tlperl\bin\lwp-download
-E:\tlperl\bin\lwp-download.bat
-E:\tlperl\bin\lwp-dump
-E:\tlperl\bin\lwp-dump.bat
-E:\tlperl\bin\lwp-mirror
-E:\tlperl\bin\lwp-mirror.bat
-E:\tlperl\bin\lwp-request
-E:\tlperl\bin\lwp-request.bat
-E:\tlperl\site\lib\LWP.pm
-E:\tlperl\site\lib\LWP\Authen\Basic.pm
-E:\tlperl\site\lib\LWP\Authen\Digest.pm
-E:\tlperl\site\lib\LWP\Authen\Ntlm.pm
-E:\tlperl\site\lib\LWP\ConnCache.pm
-E:\tlperl\site\lib\LWP\Debug.pm
-E:\tlperl\site\lib\LWP\DebugFile.pm
-E:\tlperl\site\lib\LWP\Debug\TraceHTTP.pm
-E:\tlperl\site\lib\LWP\MemberMixin.pm
-E:\tlperl\site\lib\LWP\Protocol.pm
-E:\tlperl\site\lib\LWP\Protocol\cpan.pm
-E:\tlperl\site\lib\LWP\Protocol\data.pm
-E:\tlperl\site\lib\LWP\Protocol\file.pm
-E:\tlperl\site\lib\LWP\Protocol\ftp.pm
-E:\tlperl\site\lib\LWP\Protocol\gopher.pm
-E:\tlperl\site\lib\LWP\Protocol\http.pm
-E:\tlperl\site\lib\LWP\Protocol\loopback.pm
-E:\tlperl\site\lib\LWP\Protocol\mailto.pm
-E:\tlperl\site\lib\LWP\Protocol\nntp.pm
-E:\tlperl\site\lib\LWP\Protocol\nogo.pm
-E:\tlperl\site\lib\LWP\RobotUA.pm
-E:\tlperl\site\lib\LWP\Simple.pm
-E:\tlperl\site\lib\LWP\UserAgent.pm
-E:\tlperl\site\lib\libwww\lwpcook.pod
-E:\tlperl\site\lib\libwww\lwptut.pod
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwpcook.pod b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwpcook.pod
deleted file mode 100644
index b4d4989a6a..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwpcook.pod
+++ /dev/null
@@ -1,310 +0,0 @@
-=head1 NAME
-
-lwpcook - The libwww-perl cookbook
-
-=head1 DESCRIPTION
-
-This document contain some examples that show typical usage of the
-libwww-perl library. You should consult the documentation for the
-individual modules for more detail.
-
-All examples should be runnable programs. You can, in most cases, test
-the code sections by piping the program text directly to perl.
-
-
-
-=head1 GET
-
-It is very easy to use this library to just fetch documents from the
-net. The LWP::Simple module provides the get() function that return
-the document specified by its URL argument:
-
- use LWP::Simple;
- $doc = get 'http://search.cpan.org/dist/libwww-perl/';
-
-or, as a perl one-liner using the getprint() function:
-
- perl -MLWP::Simple -e 'getprint "http://search.cpan.org/dist/libwww-perl/"'
-
-or, how about fetching the latest perl by running this command:
-
- perl -MLWP::Simple -e '
- getstore "ftp://ftp.sunet.se/pub/lang/perl/CPAN/src/latest.tar.gz",
- "perl.tar.gz"'
-
-You will probably first want to find a CPAN site closer to you by
-running something like the following command:
-
- perl -MLWP::Simple -e 'getprint "http://www.cpan.org/SITES.html"'
-
-Enough of this simple stuff! The LWP object oriented interface gives
-you more control over the request sent to the server. Using this
-interface you have full control over headers sent and how you want to
-handle the response returned.
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
- $ua->agent("$0/0.1 " . $ua->agent);
- # $ua->agent("Mozilla/8.0") # pretend we are very capable browser
-
- $req = HTTP::Request->new(
- GET => 'http://search.cpan.org/dist/libwww-perl/');
- $req->header('Accept' => 'text/html');
-
- # send request
- $res = $ua->request($req);
-
- # check the outcome
- if ($res->is_success) {
- print $res->decoded_content;
- }
- else {
- print "Error: " . $res->status_line . "\n";
- }
-
-The lwp-request program (alias GET) that is distributed with the
-library can also be used to fetch documents from WWW servers.
-
-
-
-=head1 HEAD
-
-If you just want to check if a document is present (i.e. the URL is
-valid) try to run code that looks like this:
-
- use LWP::Simple;
-
- if (head($url)) {
- # ok document exists
- }
-
-The head() function really returns a list of meta-information about
-the document. The first three values of the list returned are the
-document type, the size of the document, and the age of the document.
-
-More control over the request or access to all header values returned
-require that you use the object oriented interface described for GET
-above. Just s/GET/HEAD/g.
-
-
-=head1 POST
-
-There is no simple procedural interface for posting data to a WWW server. You
-must use the object oriented interface for this. The most common POST
-operation is to access a WWW form application:
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
-
- my $req = HTTP::Request->new(
- POST => 'https://rt.cpan.org/Public/Dist/Display.html');
- $req->content_type('application/x-www-form-urlencoded');
- $req->content('Status=Active&Name=libwww-perl');
-
- my $res = $ua->request($req);
- print $res->as_string;
-
-Lazy people use the HTTP::Request::Common module to set up a suitable
-POST request message (it handles all the escaping issues) and has a
-suitable default for the content_type:
-
- use HTTP::Request::Common qw(POST);
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
-
- my $req = POST 'https://rt.cpan.org/Public/Dist/Display.html',
- [ Status => 'Active', Name => 'libwww-perl' ];
-
- print $ua->request($req)->as_string;
-
-The lwp-request program (alias POST) that is distributed with the
-library can also be used for posting data.
-
-
-
-=head1 PROXIES
-
-Some sites use proxies to go through fire wall machines, or just as
-cache in order to improve performance. Proxies can also be used for
-accessing resources through protocols not supported directly (or
-supported badly :-) by the libwww-perl library.
-
-You should initialize your proxy setting before you start sending
-requests:
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
- $ua->env_proxy; # initialize from environment variables
- # or
- $ua->proxy(ftp => 'http://proxy.myorg.com');
- $ua->proxy(wais => 'http://proxy.myorg.com');
- $ua->no_proxy(qw(no se fi));
-
- my $req = HTTP::Request->new(GET => 'wais://xxx.com/');
- print $ua->request($req)->as_string;
-
-The LWP::Simple interface will call env_proxy() for you automatically.
-Applications that use the $ua->env_proxy() method will normally not
-use the $ua->proxy() and $ua->no_proxy() methods.
-
-Some proxies also require that you send it a username/password in
-order to let requests through. You should be able to add the
-required header, with something like this:
-
- use LWP::UserAgent;
-
- $ua = LWP::UserAgent->new;
- $ua->proxy(['http', 'ftp'] => 'http://username:password@proxy.myorg.com');
-
- $req = HTTP::Request->new('GET',"http://www.perl.com");
-
- $res = $ua->request($req);
- print $res->decoded_content if $res->is_success;
-
-Replace C<proxy.myorg.com>, C<username> and
-C<password> with something suitable for your site.
-
-
-=head1 ACCESS TO PROTECTED DOCUMENTS
-
-Documents protected by basic authorization can easily be accessed
-like this:
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
- $req = HTTP::Request->new(GET => 'http://www.linpro.no/secret/');
- $req->authorization_basic('aas', 'mypassword');
- print $ua->request($req)->as_string;
-
-The other alternative is to provide a subclass of I<LWP::UserAgent> that
-overrides the get_basic_credentials() method. Study the I<lwp-request>
-program for an example of this.
-
-
-=head1 COOKIES
-
-Some sites like to play games with cookies. By default LWP ignores
-cookies provided by the servers it visits. LWP will collect cookies
-and respond to cookie requests if you set up a cookie jar. LWP doesn't
-provide a cookie jar itself, but if you install L<HTTP::CookieJar::LWP>,
-it can be used like this:
-
- use LWP::UserAgent;
- use HTTP::CookieJar::LWP;
-
- $ua = LWP::UserAgent->new(
- cookie_jar => HTTP::CookieJar::LWP->new,
- );
-
- # and then send requests just as you used to do
- $res = $ua->request(HTTP::Request->new(GET => "http://no.yahoo.com/"));
- print $res->status_line, "\n";
-
-=head1 HTTPS
-
-URLs with https scheme are accessed in exactly the same way as with
-http scheme, provided that an SSL interface module for LWP has been
-properly installed (see the F<README.SSL> file found in the
-libwww-perl distribution for more details). If no SSL interface is
-installed for LWP to use, then you will get "501 Protocol scheme
-'https' is not supported" errors when accessing such URLs.
-
-Here's an example of fetching and printing a WWW page using SSL:
-
- use LWP::UserAgent;
-
- my $ua = LWP::UserAgent->new;
- my $req = HTTP::Request->new(GET => 'https://www.helsinki.fi/');
- my $res = $ua->request($req);
- if ($res->is_success) {
- print $res->as_string;
- }
- else {
- print "Failed: ", $res->status_line, "\n";
- }
-
-=head1 MIRRORING
-
-If you want to mirror documents from a WWW server, then try to run
-code similar to this at regular intervals:
-
- use LWP::Simple;
-
- %mirrors = (
- 'http://www.sn.no/' => 'sn.html',
- 'http://www.perl.com/' => 'perl.html',
- 'http://search.cpan.org/distlibwww-perl/' => 'lwp.html',
- 'gopher://gopher.sn.no/' => 'gopher.html',
- );
-
- while (($url, $localfile) = each(%mirrors)) {
- mirror($url, $localfile);
- }
-
-Or, as a perl one-liner:
-
- perl -MLWP::Simple -e 'mirror("http://www.perl.com/", "perl.html")';
-
-The document will not be transferred unless it has been updated.
-
-
-
-=head1 LARGE DOCUMENTS
-
-If the document you want to fetch is too large to be kept in memory,
-then you have two alternatives. You can instruct the library to write
-the document content to a file (second $ua->request() argument is a file
-name):
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
-
- my $req = HTTP::Request->new(GET =>
- 'http://www.cpan.org/CPAN/authors/id/O/OA/OALDERS/libwww-perl-6.26.tar.gz');
- $res = $ua->request($req, "libwww-perl.tar.gz");
- if ($res->is_success) {
- print "ok\n";
- }
- else {
- print $res->status_line, "\n";
- }
-
-
-Or you can process the document as it arrives (second $ua->request()
-argument is a code reference):
-
- use LWP::UserAgent;
- $ua = LWP::UserAgent->new;
- $URL = 'ftp://ftp.isc.org/pub/rfc/rfc-index.txt';
-
- my $expected_length;
- my $bytes_received = 0;
- my $res =
- $ua->request(HTTP::Request->new(GET => $URL),
- sub {
- my($chunk, $res) = @_;
- $bytes_received += length($chunk);
- unless (defined $expected_length) {
- $expected_length = $res->content_length || 0;
- }
- if ($expected_length) {
- printf STDERR "%d%% - ",
- 100 * $bytes_received / $expected_length;
- }
- print STDERR "$bytes_received bytes received\n";
-
- # XXX Should really do something with the chunk itself
- # print $chunk;
- });
- print $res->status_line, "\n";
-
-
-
-=head1 COPYRIGHT
-
-Copyright 1996-2001, Gisle Aas
-
-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/libwww/lwptut.pod b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwptut.pod
deleted file mode 100644
index f9f98a0f15..0000000000
--- a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwptut.pod
+++ /dev/null
@@ -1,820 +0,0 @@
-=head1 NAME
-
-lwptut -- An LWP Tutorial
-
-=head1 DESCRIPTION
-
-LWP (short for "Library for WWW in Perl") is a very popular group of
-Perl modules for accessing data on the Web. Like most Perl
-module-distributions, each of LWP's component modules comes with
-documentation that is a complete reference to its interface. However,
-there are so many modules in LWP that it's hard to know where to start
-looking for information on how to do even the simplest most common
-things.
-
-Really introducing you to using LWP would require a whole book -- a book
-that just happens to exist, called I<Perl & LWP>. But this article
-should give you a taste of how you can go about some common tasks with
-LWP.
-
-
-=head2 Getting documents with LWP::Simple
-
-If you just want to get what's at a particular URL, the simplest way
-to do it is LWP::Simple's functions.
-
-In a Perl program, you can call its C<get($url)> function. It will try
-getting that URL's content. If it works, then it'll return the
-content; but if there's some error, it'll return undef.
-
- my $url = 'http://www.npr.org/programs/fa/?todayDate=current';
- # Just an example: the URL for the most recent /Fresh Air/ show
-
- use LWP::Simple;
- my $content = get $url;
- die "Couldn't get $url" unless defined $content;
-
- # Then go do things with $content, like this:
-
- if($content =~ m/jazz/i) {
- print "They're talking about jazz today on Fresh Air!\n";
- }
- else {
- print "Fresh Air is apparently jazzless today.\n";
- }
-
-The handiest variant on C<get> is C<getprint>, which is useful in Perl
-one-liners. If it can get the page whose URL you provide, it sends it
-to STDOUT; otherwise it complains to STDERR.
-
- % perl -MLWP::Simple -e "getprint 'http://www.cpan.org/RECENT'"
-
-That is the URL of a plain text file that lists new files in CPAN in
-the past two weeks. You can easily make it part of a tidy little
-shell command, like this one that mails you the list of new
-C<Acme::> modules:
-
- % perl -MLWP::Simple -e "getprint 'http://www.cpan.org/RECENT'" \
- | grep "/by-module/Acme" | mail -s "New Acme modules! Joy!" $USER
-
-There are other useful functions in LWP::Simple, including one function
-for running a HEAD request on a URL (useful for checking links, or
-getting the last-revised time of a URL), and two functions for
-saving/mirroring a URL to a local file. See L<the LWP::Simple
-documentation|LWP::Simple> for the full details, or chapter 2 of I<Perl
-& LWP> for more examples.
-
-
-
-=for comment
- ##########################################################################
-
-
-
-=head2 The Basics of the LWP Class Model
-
-LWP::Simple's functions are handy for simple cases, but its functions
-don't support cookies or authorization, don't support setting header
-lines in the HTTP request, generally don't support reading header lines
-in the HTTP response (notably the full HTTP error message, in case of an
-error). To get at all those features, you'll have to use the full LWP
-class model.
-
-While LWP consists of dozens of classes, the main two that you have to
-understand are L<LWP::UserAgent> and L<HTTP::Response>. LWP::UserAgent
-is a class for "virtual browsers" which you use for performing requests,
-and L<HTTP::Response> is a class for the responses (or error messages)
-that you get back from those requests.
-
-The basic idiom is C<< $response = $browser->get($url) >>, or more fully
-illustrated:
-
- # Early in your program:
-
- use LWP 5.64; # Loads all important LWP classes, and makes
- # sure your version is reasonably recent.
-
- my $browser = LWP::UserAgent->new;
-
- ...
-
- # Then later, whenever you need to make a get request:
- my $url = 'http://www.npr.org/programs/fa/?todayDate=current';
-
- my $response = $browser->get( $url );
- die "Can't get $url -- ", $response->status_line
- unless $response->is_success;
-
- die "Hey, I was expecting HTML, not ", $response->content_type
- unless $response->content_type eq 'text/html';
- # or whatever content-type you're equipped to deal with
-
- # Otherwise, process the content somehow:
-
- if($response->decoded_content =~ m/jazz/i) {
- print "They're talking about jazz today on Fresh Air!\n";
- }
- else {
- print "Fresh Air is apparently jazzless today.\n";
- }
-
-There are two objects involved: C<$browser>, which holds an object of
-class LWP::UserAgent, and then the C<$response> object, which is of
-class HTTP::Response. You really need only one browser object per
-program; but every time you make a request, you get back a new
-HTTP::Response object, which will have some interesting attributes:
-
-=over
-
-=item *
-
-A status code indicating
-success or failure
-(which you can test with C<< $response->is_success >>).
-
-=item *
-
-An HTTP status
-line that is hopefully informative if there's failure (which you can
-see with C<< $response->status_line >>,
-returning something like "404 Not Found").
-
-=item *
-
-A MIME content-type like "text/html", "image/gif",
-"application/xml", etc., which you can see with
-C<< $response->content_type >>
-
-=item *
-
-The actual content of the response, in C<< $response->decoded_content >>.
-If the response is HTML, that's where the HTML source will be; if
-it's a GIF, then C<< $response->decoded_content >> will be the binary
-GIF data.
-
-=item *
-
-And dozens of other convenient and more specific methods that are
-documented in the docs for L<HTTP::Response>, and its superclasses
-L<HTTP::Message> and L<HTTP::Headers>.
-
-=back
-
-
-
-=for comment
- ##########################################################################
-
-
-
-=head2 Adding Other HTTP Request Headers
-
-The most commonly used syntax for requests is C<< $response =
-$browser->get($url) >>, but in truth, you can add extra HTTP header
-lines to the request by adding a list of key-value pairs after the URL,
-like so:
-
- $response = $browser->get( $url, $key1, $value1, $key2, $value2, ... );
-
-For example, here's how to send some commonly used headers, in case
-you're dealing with a site that would otherwise reject your request:
-
-
- my @ns_headers = (
- 'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)',
- 'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*',
- 'Accept-Charset' => 'iso-8859-1,*,utf-8',
- 'Accept-Language' => 'en-US',
- );
-
- ...
-
- $response = $browser->get($url, @ns_headers);
-
-If you weren't reusing that array, you could just go ahead and do this:
-
- $response = $browser->get($url,
- 'User-Agent' => 'Mozilla/4.76 [en] (Win98; U)',
- 'Accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*',
- 'Accept-Charset' => 'iso-8859-1,*,utf-8',
- 'Accept-Language' => 'en-US',
- );
-
-If you were only ever changing the 'User-Agent' line, you could just change
-the C<$browser> object's default line from "libwww-perl/5.65" (or the like)
-to whatever you like, using the LWP::UserAgent C<agent> method:
-
- $browser->agent('Mozilla/4.76 [en] (Win98; U)');
-
-
-
-=for comment
- ##########################################################################
-
-
-
-=head2 Enabling Cookies
-
-A default LWP::UserAgent object acts like a browser with its cookies
-support turned off. There are various ways of turning it on, by setting
-its C<cookie_jar> attribute. A "cookie jar" is an object representing
-a little database of all
-the HTTP cookies that a browser knows about. It can correspond to a
-file on disk or
-an in-memory object that starts out empty, and whose collection of
-cookies will disappear once the program is finished running.
-
-To give a browser an in-memory empty cookie jar, you set its C<cookie_jar>
-attribute like so:
-
- use HTTP::CookieJar::LWP;
- $browser->cookie_jar( HTTP::CookieJar::LWP->new );
-
-To save a cookie jar to disk, see L<< HTTP::CookieJar/dump_cookies >>.
-To load cookies from disk into a jar, see L<<
-HTTP::CookieJar/load_cookies >>.
-
-=for comment
- ##########################################################################
-
-
-
-=head2 Posting Form Data
-
-Many HTML forms send data to their server using an HTTP POST request, which
-you can send with this syntax:
-
- $response = $browser->post( $url,
- [
- formkey1 => value1,
- formkey2 => value2,
- ...
- ],
- );
-
-Or if you need to send HTTP headers:
-
- $response = $browser->post( $url,
- [
- formkey1 => value1,
- formkey2 => value2,
- ...
- ],
- headerkey1 => value1,
- headerkey2 => value2,
- );
-
-For example, the following program makes a search request to AltaVista
-(by sending some form data via an HTTP POST request), and extracts from
-the HTML the report of the number of matches:
-
- use strict;
- use warnings;
- use LWP 5.64;
- my $browser = LWP::UserAgent->new;
-
- my $word = 'tarragon';
-
- my $url = 'http://search.yahoo.com/yhs/search';
- my $response = $browser->post( $url,
- [ 'q' => $word, # the Altavista query string
- 'fr' => 'altavista', 'pg' => 'q', 'avkw' => 'tgz', 'kl' => 'XX',
- ]
- );
- die "$url error: ", $response->status_line
- unless $response->is_success;
- die "Weird content type at $url -- ", $response->content_type
- unless $response->content_is_html;
-
- if( $response->decoded_content =~ m{([0-9,]+)(?:<.*?>)? results for} ) {
- # The substring will be like "996,000</strong> results for"
- print "$word: $1\n";
- }
- else {
- print "Couldn't find the match-string in the response\n";
- }
-
-
-
-=for comment
- ##########################################################################
-
-
-
-=head2 Sending GET Form Data
-
-Some HTML forms convey their form data not by sending the data
-in an HTTP POST request, but by making a normal GET request with
-the data stuck on the end of the URL. For example, if you went to
-C<www.imdb.com> and ran a search on "Blade Runner", the URL you'd see
-in your browser window would be:
-
- http://www.imdb.com/find?s=all&q=Blade+Runner
-
-To run the same search with LWP, you'd use this idiom, which involves
-the URI class:
-
- use URI;
- my $url = URI->new( 'http://www.imdb.com/find' );
- # makes an object representing the URL
-
- $url->query_form( # And here the form data pairs:
- 'q' => 'Blade Runner',
- 's' => 'all',
- );
-
- my $response = $browser->get($url);
-
-See chapter 5 of I<Perl & LWP> for a longer discussion of HTML forms
-and of form data, and chapters 6 through 9 for a longer discussion of
-extracting data from HTML.
-
-
-
-=head2 Absolutizing URLs
-
-The URI class that we just mentioned above provides all sorts of methods
-for accessing and modifying parts of URLs (such as asking sort of URL it
-is with C<< $url->scheme >>, and asking what host it refers to with C<<
-$url->host >>, and so on, as described in L<the docs for the URI
-class|URI>. However, the methods of most immediate interest
-are the C<query_form> method seen above, and now the C<new_abs> method
-for taking a probably-relative URL string (like "../foo.html") and getting
-back an absolute URL (like "http://www.perl.com/stuff/foo.html"), as
-shown here:
-
- use URI;
- $abs = URI->new_abs($maybe_relative, $base);
-
-For example, consider this program that matches URLs in the HTML
-list of new modules in CPAN:
-
- use strict;
- use warnings;
- use LWP;
- my $browser = LWP::UserAgent->new;
-
- my $url = 'http://www.cpan.org/RECENT.html';
- my $response = $browser->get($url);
- die "Can't get $url -- ", $response->status_line
- unless $response->is_success;
-
- my $html = $response->decoded_content;
- while( $html =~ m/<A HREF=\"(.*?)\"/g ) {
- print "$1\n";
- }
-
-When run, it emits output that starts out something like this:
-
- MIRRORING.FROM
- RECENT
- RECENT.html
- authors/00whois.html
- authors/01mailrc.txt.gz
- authors/id/A/AA/AASSAD/CHECKSUMS
- ...
-
-However, if you actually want to have those be absolute URLs, you
-can use the URI module's C<new_abs> method, by changing the C<while>
-loop to this:
-
- while( $html =~ m/<A HREF=\"(.*?)\"/g ) {
- print URI->new_abs( $1, $response->base ) ,"\n";
- }
-
-(The C<< $response->base >> method from L<HTTP::Message|HTTP::Message>
-is for returning what URL
-should be used for resolving relative URLs -- it's usually just
-the same as the URL that you requested.)
-
-That program then emits nicely absolute URLs:
-
- http://www.cpan.org/MIRRORING.FROM
- http://www.cpan.org/RECENT
- http://www.cpan.org/RECENT.html
- http://www.cpan.org/authors/00whois.html
- http://www.cpan.org/authors/01mailrc.txt.gz
- http://www.cpan.org/authors/id/A/AA/AASSAD/CHECKSUMS
- ...
-
-See chapter 4 of I<Perl & LWP> for a longer discussion of URI objects.
-
-Of course, using a regexp to match hrefs is a bit simplistic, and for
-more robust programs, you'll probably want to use an HTML-parsing module
-like L<HTML::LinkExtor> or L<HTML::TokeParser> or even maybe
-L<HTML::TreeBuilder>.
-
-
-
-
-=for comment
- ##########################################################################
-
-=head2 Other Browser Attributes
-
-LWP::UserAgent objects have many attributes for controlling how they
-work. Here are a few notable ones:
-
-=over
-
-=item *
-
-C<< $browser->timeout(15); >>
-
-This sets this browser object to give up on requests that don't answer
-within 15 seconds.
-
-
-=item *
-
-C<< $browser->protocols_allowed( [ 'http', 'gopher'] ); >>
-
-This sets this browser object to not speak any protocols other than HTTP
-and gopher. If it tries accessing any other kind of URL (like an "ftp:"
-or "mailto:" or "news:" URL), then it won't actually try connecting, but
-instead will immediately return an error code 500, with a message like
-"Access to 'ftp' URIs has been disabled".
-
-
-=item *
-
-C<< use LWP::ConnCache; $browser->conn_cache(LWP::ConnCache->new()); >>
-
-This tells the browser object to try using the HTTP/1.1 "Keep-Alive"
-feature, which speeds up requests by reusing the same socket connection
-for multiple requests to the same server.
-
-
-=item *
-
-C<< $browser->agent( 'SomeName/1.23 (more info here maybe)' ) >>
-
-This changes how the browser object will identify itself in
-the default "User-Agent" line is its HTTP requests. By default,
-it'll send "libwww-perl/I<versionnumber>", like
-"libwww-perl/5.65". You can change that to something more descriptive
-like this:
-
- $browser->agent( 'SomeName/3.14 (contact@robotplexus.int)' );
-
-Or if need be, you can go in disguise, like this:
-
- $browser->agent( 'Mozilla/4.0 (compatible; MSIE 5.12; Mac_PowerPC)' );
-
-
-=item *
-
-C<< push @{ $ua->requests_redirectable }, 'POST'; >>
-
-This tells this browser to obey redirection responses to POST requests
-(like most modern interactive browsers), even though the HTTP RFC says
-that should not normally be done.
-
-
-=back
-
-
-For more options and information, see L<the full documentation for
-LWP::UserAgent|LWP::UserAgent>.
-
-
-
-=for comment
- ##########################################################################
-
-
-
-=head2 Writing Polite Robots
-
-If you want to make sure that your LWP-based program respects F<robots.txt>
-files and doesn't make too many requests too fast, you can use the LWP::RobotUA
-class instead of the LWP::UserAgent class.
-
-LWP::RobotUA class is just like LWP::UserAgent, and you can use it like so:
-
- use LWP::RobotUA;
- my $browser = LWP::RobotUA->new('YourSuperBot/1.34', 'you@yoursite.com');
- # Your bot's name and your email address
-
- my $response = $browser->get($url);
-
-But HTTP::RobotUA adds these features:
-
-
-=over
-
-=item *
-
-If the F<robots.txt> on C<$url>'s server forbids you from accessing
-C<$url>, then the C<$browser> object (assuming it's of class LWP::RobotUA)
-won't actually request it, but instead will give you back (in C<$response>) a 403 error
-with a message "Forbidden by robots.txt". That is, if you have this line:
-
- die "$url -- ", $response->status_line, "\nAborted"
- unless $response->is_success;
-
-then the program would die with an error message like this:
-
- http://whatever.site.int/pith/x.html -- 403 Forbidden by robots.txt
- Aborted at whateverprogram.pl line 1234
-
-=item *
-
-If this C<$browser> object sees that the last time it talked to
-C<$url>'s server was too recently, then it will pause (via C<sleep>) to
-avoid making too many requests too often. How long it will pause for, is
-by default one minute -- but you can control it with the C<<
-$browser->delay( I<minutes> ) >> attribute.
-
-For example, this code:
-
- $browser->delay( 7/60 );
-
-...means that this browser will pause when it needs to avoid talking to
-any given server more than once every 7 seconds.
-
-=back
-
-For more options and information, see L<the full documentation for
-LWP::RobotUA|LWP::RobotUA>.
-
-
-
-
-
-=for comment
- ##########################################################################
-
-=head2 Using Proxies
-
-In some cases, you will want to (or will have to) use proxies for
-accessing certain sites and/or using certain protocols. This is most
-commonly the case when your LWP program is running (or could be running)
-on a machine that is behind a firewall.
-
-To make a browser object use proxies that are defined in the usual
-environment variables (C<HTTP_PROXY>, etc.), just call the C<env_proxy>
-on a user-agent object before you go making any requests on it.
-Specifically:
-
- use LWP::UserAgent;
- my $browser = LWP::UserAgent->new;
-
- # And before you go making any requests:
- $browser->env_proxy;
-
-For more information on proxy parameters, see L<the LWP::UserAgent
-documentation|LWP::UserAgent>, specifically the C<proxy>, C<env_proxy>,
-and C<no_proxy> methods.
-
-
-
-=for comment
- ##########################################################################
-
-=head2 HTTP Authentication
-
-Many web sites restrict access to documents by using "HTTP
-Authentication". This isn't just any form of "enter your password"
-restriction, but is a specific mechanism where the HTTP server sends the
-browser an HTTP code that says "That document is part of a protected
-'realm', and you can access it only if you re-request it and add some
-special authorization headers to your request".
-
-For example, the Unicode.org admins stop email-harvesting bots from
-harvesting the contents of their mailing list archives, by protecting
-them with HTTP Authentication, and then publicly stating the username
-and password (at C<http://www.unicode.org/mail-arch/>) -- namely
-username "unicode-ml" and password "unicode".
-
-For example, consider this URL, which is part of the protected
-area of the web site:
-
- http://www.unicode.org/mail-arch/unicode-ml/y2002-m08/0067.html
-
-If you access that with a browser, you'll get a prompt
-like
-"Enter username and password for 'Unicode-MailList-Archives' at server
-'www.unicode.org'".
-
-In LWP, if you just request that URL, like this:
-
- use LWP;
- my $browser = LWP::UserAgent->new;
-
- my $url =
- 'http://www.unicode.org/mail-arch/unicode-ml/y2002-m08/0067.html';
- my $response = $browser->get($url);
-
- die "Error: ", $response->header('WWW-Authenticate') || 'Error accessing',
- # ('WWW-Authenticate' is the realm-name)
- "\n ", $response->status_line, "\n at $url\n Aborting"
- unless $response->is_success;
-
-Then you'll get this error:
-
- Error: Basic realm="Unicode-MailList-Archives"
- 401 Authorization Required
- at http://www.unicode.org/mail-arch/unicode-ml/y2002-m08/0067.html
- Aborting at auth1.pl line 9. [or wherever]
-
-...because the C<$browser> doesn't know any the username and password
-for that realm ("Unicode-MailList-Archives") at that host
-("www.unicode.org"). The simplest way to let the browser know about this
-is to use the C<credentials> method to let it know about a username and
-password that it can try using for that realm at that host. The syntax is:
-
- $browser->credentials(
- 'servername:portnumber',
- 'realm-name',
- 'username' => 'password'
- );
-
-In most cases, the port number is 80, the default TCP/IP port for HTTP; and
-you usually call the C<credentials> method before you make any requests.
-For example:
-
- $browser->credentials(
- 'reports.mybazouki.com:80',
- 'web_server_usage_reports',
- 'plinky' => 'banjo123'
- );
-
-So if we add the following to the program above, right after the C<<
-$browser = LWP::UserAgent->new; >> line...
-
- $browser->credentials( # add this to our $browser 's "key ring"
- 'www.unicode.org:80',
- 'Unicode-MailList-Archives',
- 'unicode-ml' => 'unicode'
- );
-
-...then when we run it, the request succeeds, instead of causing the
-C<die> to be called.
-
-
-
-=for comment
- ##########################################################################
-
-=head2 Accessing HTTPS URLs
-
-When you access an HTTPS URL, it'll work for you just like an HTTP URL
-would -- if your LWP installation has HTTPS support (via an appropriate
-Secure Sockets Layer library). For example:
-
- use LWP;
- my $url = 'https://www.paypal.com/'; # Yes, HTTPS!
- my $browser = LWP::UserAgent->new;
- my $response = $browser->get($url);
- die "Error at $url\n ", $response->status_line, "\n Aborting"
- unless $response->is_success;
- print "Whee, it worked! I got that ",
- $response->content_type, " document!\n";
-
-If your LWP installation doesn't have HTTPS support set up, then the
-response will be unsuccessful, and you'll get this error message:
-
- Error at https://www.paypal.com/
- 501 Protocol scheme 'https' is not supported
- Aborting at paypal.pl line 7. [or whatever program and line]
-
-If your LWP installation I<does> have HTTPS support installed, then the
-response should be successful, and you should be able to consult
-C<$response> just like with any normal HTTP response.
-
-For information about installing HTTPS support for your LWP
-installation, see the helpful F<README.SSL> file that comes in the
-libwww-perl distribution.
-
-
-=for comment
- ##########################################################################
-
-
-
-=head2 Getting Large Documents
-
-When you're requesting a large (or at least potentially large) document,
-a problem with the normal way of using the request methods (like C<<
-$response = $browser->get($url) >>) is that the response object in
-memory will have to hold the whole document -- I<in memory>. If the
-response is a thirty megabyte file, this is likely to be quite an
-imposition on this process's memory usage.
-
-A notable alternative is to have LWP save the content to a file on disk,
-instead of saving it up in memory. This is the syntax to use:
-
- $response = $ua->get($url,
- ':content_file' => $filespec,
- );
-
-For example,
-
- $response = $ua->get('http://search.cpan.org/',
- ':content_file' => '/tmp/sco.html'
- );
-
-When you use this C<:content_file> option, the C<$response> will have
-all the normal header lines, but C<< $response->content >> will be
-empty. Errors writing to the content file (for example due to
-permission denied or the filesystem being full) will be reported via
-the C<Client-Aborted> or C<X-Died> response headers, and not the
-C<is_success> method:
-
- if ($response->header('Client-Aborted') eq 'die') {
- # handle error ...
-
-Note that this ":content_file" option isn't supported under older
-versions of LWP, so you should consider adding C<use LWP 5.66;> to check
-the LWP version, if you think your program might run on systems with
-older versions.
-
-If you need to be compatible with older LWP versions, then use
-this syntax, which does the same thing:
-
- use HTTP::Request::Common;
- $response = $ua->request( GET($url), $filespec );
-
-
-=for comment
- ##########################################################################
-
-
-=head1 SEE ALSO
-
-Remember, this article is just the most rudimentary introduction to
-LWP -- to learn more about LWP and LWP-related tasks, you really
-must read from the following:
-
-=over
-
-=item *
-
-L<LWP::Simple> -- simple functions for getting/heading/mirroring URLs
-
-=item *
-
-L<LWP> -- overview of the libwww-perl modules
-
-=item *
-
-L<LWP::UserAgent> -- the class for objects that represent "virtual browsers"
-
-=item *
-
-L<HTTP::Response> -- the class for objects that represent the response to
-a LWP response, as in C<< $response = $browser->get(...) >>
-
-=item *
-
-L<HTTP::Message> and L<HTTP::Headers> -- classes that provide more methods
-to HTTP::Response.
-
-=item *
-
-L<URI> -- class for objects that represent absolute or relative URLs
-
-=item *
-
-L<URI::Escape> -- functions for URL-escaping and URL-unescaping strings
-(like turning "this & that" to and from "this%20%26%20that").
-
-=item *
-
-L<HTML::Entities> -- functions for HTML-escaping and HTML-unescaping strings
-(like turning "C. & E. BrontE<euml>" to and from "C. &amp; E. Bront&euml;")
-
-=item *
-
-L<HTML::TokeParser> and L<HTML::TreeBuilder> -- classes for parsing HTML
-
-=item *
-
-L<HTML::LinkExtor> -- class for finding links in HTML documents
-
-=item *
-
-The book I<Perl & LWP> by Sean M. Burke. O'Reilly & Associates,
-2002. ISBN: 0-596-00178-9, L<http://oreilly.com/catalog/perllwp/>. The
-whole book is also available free online:
-L<http://lwp.interglacial.com>.
-
-=back
-
-
-=head1 COPYRIGHT
-
-Copyright 2002, Sean M. Burke. You can redistribute this document and/or
-modify it, but only under the same terms as Perl itself.
-
-=head1 AUTHOR
-
-Sean M. Burke C<sburke@cpan.org>
-
-=for comment
- ##########################################################################
-
-=cut
-
-# End of Pod