summaryrefslogtreecommitdiff
path: root/systems/texlive/tlnet/tlpkg/tlperl/site
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/texlive/tlnet/tlpkg/tlperl/site
Initial commit
Diffstat (limited to 'systems/texlive/tlnet/tlpkg/tlperl/site')
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS.pm2332
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS/Boolean.pm29
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS/Type.pm311
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Format.pm403
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language.pm144
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Afar.pm49
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Amharic.pm87
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Austrian.pm36
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Brazilian.pm35
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Bulgarian.pm92
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Chinese.pm36
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Chinese_GB.pm36
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Czech.pm58
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Danish.pm36
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Dutch.pm40
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/English.pm37
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Finnish.pm45
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/French.pm36
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Gedeo.pm51
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/German.pm37
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Greek.pm91
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Hungarian.pm88
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Icelandic.pm36
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Italian.pm36
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Norwegian.pm36
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Oromo.pm37
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Romanian.pm37
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian.pm49
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian_cp1251.pm39
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian_koi8r.pm39
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Sidama.pm37
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Somali.pm62
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Spanish.pm35
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Swedish.pm41
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Tigrinya.pm58
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/TigrinyaEritrean.pm93
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/TigrinyaEthiopian.pm93
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Turkish.pm59
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Parse.pm380
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Digest/SHA1.pm246
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/Locale.pm373
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat.pm87
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/5006001.pm32
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/Alias.pm330
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/common.pm127
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Listing.pm435
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Which.pm392
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm483
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm112
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm315
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm185
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm1234
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm209
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Tagset.pm471
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm371
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Config.pm454
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm844
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm326
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm127
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm906
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm388
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers.pm890
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/Auth.pm127
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/ETag.pm123
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/Util.pm213
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Message.pm1133
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Negotiate.pm528
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Request.pm344
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Request/Common.pm560
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Response.pm665
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Status.pm348
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/IO/HTML.pm575
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/IO/String.pm551
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/JSON/MaybeXS.pm334
-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.pm68
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm77
-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/MediaTypes.pm280
-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.pm2011
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/media.types1479
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm589
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64/die_on_overflow.pm45
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64/native_if_available.pm43
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/UInt64.pm32
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA.pm74
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA/cacert.pem3467
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/mk-ca-bundle.pl553
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP.pm307
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/Methods.pm669
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm121
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm135
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/OLE.pm177
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Socket.pm1138
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm364
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm315
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm131
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Tie/Registry.pm45
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Time/Zone.pm291
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Try/Tiny.pm813
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm1162
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm221
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm253
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm47
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm207
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm97
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm303
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm174
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm10
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm256
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm91
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm140
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm13
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm217
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm97
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm24
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm166
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm55
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm142
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm327
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm84
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm27
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm121
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm32
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm20
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm58
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm87
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm46
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm97
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm27
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm14
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm120
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm29
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm14
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm73
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm12
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm71
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm10
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm71
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm12
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm14
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm12
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm12
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm10
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm85
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm14
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm14
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm16
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm12
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm12
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm105
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm105
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm20
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/WWW/RobotRules.pm453
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/WWW/RobotRules/AnyDBM_File.pm170
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API.pm1474
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Callback.pm575
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Callback/IATPatch.pod181
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Struct.pm755
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Type.pm590
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/Console.pm1463
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE.pm968
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm201
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm95
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm224
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod380
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm968
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod798
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm389
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm577
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/Shortcut.pm752
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/TieRegistry.pm3803
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/WinError.pm1017
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32API/Registry.pm1779
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32API/Registry/cRegistry.pc87
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/.packlist6
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/XS.dllbin0 -> 83456 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Date/Parse/.packlist37
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA1/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA1/SHA1.dllbin0 -> 24064 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/Locale/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/compat/.packlist4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Listing/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Which/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/.packlist8
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/Parser.dllbin0 -> 52736 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Tagset/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Cookies/.packlist3
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Daemon/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Date/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Message/.packlist10
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Negotiate/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/HTML/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/String/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/JSON/MaybeXS/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/LWP/MediaTypes/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/.packlist5
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/Int64.dllbin0 -> 70656 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Mozilla/CA/.packlist3
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Net/HTTP/.packlist4
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/Socket.dllbin0 -> 40448 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Fatal/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Needs/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/RequiresInternet/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Try/Tiny/.packlist1
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/URI/.packlist53
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/WWW/RobotRules/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/.packlist7
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/API.dllbin0 -> 31744 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.dllbin0 -> 25600 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/Console.dllbin0 -> 50176 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist11
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dllbin0 -> 135680 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/Shortcut.dllbin0 -> 52224 bytes
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/TieRegistry/.packlist2
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/.packlist3
-rw-r--r--systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/Registry.dllbin0 -> 157184 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
241 files changed, 62080 insertions, 0 deletions
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
new file mode 100644
index 0000000000..6154f649ff
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS.pm
@@ -0,0 +1,2332 @@
+package Cpanel::JSON::XS;
+our $VERSION = '4.09';
+our $XS_VERSION = $VERSION;
+# $VERSION = eval $VERSION;
+
+=pod
+
+=head1 NAME
+
+Cpanel::JSON::XS - cPanel fork of JSON::XS, fast and correct serializing
+
+=head1 SYNOPSIS
+
+ use Cpanel::JSON::XS;
+
+ # exported functions, they croak on error
+ # and expect/generate UTF-8
+
+ $utf8_encoded_json_text = encode_json $perl_hash_or_arrayref;
+ $perl_hash_or_arrayref = decode_json $utf8_encoded_json_text;
+
+ # OO-interface
+
+ $coder = Cpanel::JSON::XS->new->ascii->pretty->allow_nonref;
+ $pretty_printed_unencoded = $coder->encode ($perl_scalar);
+ $perl_scalar = $coder->decode ($unicode_json_text);
+
+ # Note that 5.6 misses most smart utf8 and encoding functionalities
+ # of newer releases.
+
+ # Note that L<JSON::MaybeXS> will automatically use Cpanel::JSON::XS
+ # if available, at virtually no speed overhead either, so you should
+ # be able to just:
+
+ use JSON::MaybeXS;
+
+ # and do the same things, except that you have a pure-perl fallback now.
+
+=head1 DESCRIPTION
+
+This module converts Perl data structures to JSON and vice versa. Its
+primary goal is to be I<correct> and its secondary goal is to be
+I<fast>. To reach the latter goal it was written in C.
+
+As this is the n-th-something JSON module on CPAN, what was the reason
+to write yet another JSON module? While it seems there are many JSON
+modules, none of them correctly handle all corner cases, and in most cases
+their maintainers are unresponsive, gone missing, or not listening to bug
+reports for other reasons.
+
+See below for the cPanel fork.
+
+See MAPPING, below, on how Cpanel::JSON::XS maps perl values to JSON
+values and vice versa.
+
+=head2 FEATURES
+
+=over 4
+
+=item * correct Unicode handling
+
+This module knows how to handle Unicode with Perl version higher than 5.8.5,
+documents how and when it does so, and even documents what "correct" means.
+
+=item * round-trip integrity
+
+When you serialize a perl data structure using only data types supported
+by JSON and Perl, the deserialized data structure is identical on the Perl
+level. (e.g. the string "2.0" doesn't suddenly become "2" just because
+it looks like a number). There I<are> minor exceptions to this, read the
+MAPPING section below to learn about those.
+
+=item * strict checking of JSON correctness
+
+There is no guessing, no generating of illegal JSON texts by default,
+and only JSON is accepted as input by default. the latter is a security
+feature.
+
+=item * fast
+
+Compared to other JSON modules and other serializers such as Storable,
+this module usually compares favourably in terms of speed, too.
+
+=item * simple to use
+
+This module has both a simple functional interface as well as an object
+oriented interface.
+
+=item * reasonably versatile output formats
+
+You can choose between the most compact guaranteed-single-line format
+possible (nice for simple line-based protocols), a pure-ASCII format
+(for when your transport is not 8-bit clean, still supports the whole
+Unicode range), or a pretty-printed format (for when you want to read that
+stuff). Or you can combine those features in whatever way you like.
+
+=back
+
+=head2 cPanel fork
+
+Since the original author MLEHMANN has no public
+bugtracker, this cPanel fork sits now on github.
+
+src repo: L<https://github.com/rurban/Cpanel-JSON-XS>
+original: L<http://cvs.schmorp.de/JSON-XS/>
+
+RT: L<https://github.com/rurban/Cpanel-JSON-XS/issues>
+or L<https://rt.cpan.org/Public/Dist/Display.html?Queue=Cpanel-JSON-XS>
+
+B<Changes to JSON::XS>
+
+- stricter decode_json() as documented. non-refs are disallowed.
+ added a 2nd optional argument. decode() honors now allow_nonref.
+
+- fixed encode of numbers for dual-vars. Different string
+ representations are preserved, but numbers with temporary strings
+ which represent the same number are here treated as numbers, not
+ strings. Cpanel::JSON::XS is a bit slower, but preserves numeric
+ types better.
+
+- numbers ending with .0 stay numbers, are not converted to
+ integers. [#63] dual-vars which are represented as number not
+ integer (42+"bar" != 5.8.9) are now encoded as number (=> 42.0)
+ because internally it's now a NOK type. However !!1 which is
+ wrongly encoded in 5.8 as "1"/1.0 is still represented as integer.
+
+- different handling of inf/nan. Default now to null, optionally with
+ stringify_infnan() to "inf"/"nan". [#28, #32]
+
+- added C<binary> extension, non-JSON and non JSON parsable, allows
+ C<\xNN> and C<\NNN> sequences.
+
+- 5.6.2 support; sacrificing some utf8 features (assuming bytes
+ all-over), no multi-byte unicode characters with 5.6.
+
+- interop for true/false overloading. JSON::XS, JSON::PP and Mojo::JSON
+ representations for booleans are accepted and JSON::XS accepts
+ Cpanel::JSON::XS booleans [#13, #37]
+ Fixed overloading of booleans. Cpanel::JSON::XS::true stringifies again
+ to "1", not "true", analog to all other JSON modules.
+
+- native boolean mapping of yes and no to true and false, as in YAML::XS.
+ In perl C<!0> is yes, C<!1> is no.
+ The JSON value true maps to 1, false maps to 0. [#39]
+
+- support arbitrary stringification with encode, with convert_blessed
+ and allow_blessed.
+
+- ithread support. Cpanel::JSON::XS is thread-safe, JSON::XS not
+
+- is_bool can be called as method, JSON::XS::is_bool not.
+
+- performance optimizations for threaded Perls
+
+- relaxed mode, allowing many popular extensions
+
+- additional fixes for:
+
+ - [cpan #88061] AIX atof without USE_LONG_DOUBLE
+
+ - #10 unshare_hek crash
+
+ - #7, #29 avoid re-blessing where possible. It fails in JSON::XS for
+ READONLY values, i.e. restricted hashes.
+
+ - #41 overloading of booleans, use the object not the reference.
+
+ - #62 -Dusequadmath conversion and no SEGV.
+
+ - #72 parsing of values followed \0, like 1\0 does fail.
+
+ - #72 parsing of illegal unicode or non-unicode characters.
+
+ - #96 locale-insensitive numeric conversion
+
+- public maintenance and bugtracker
+
+- use ppport.h, sanify XS.xs comment styles, harness C coding style
+
+- 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
+ 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.
+ relaxed implements allow_dupkeys.
+
+- support all 5 unicode BOM's: UTF-8, UTF-16LE, UTF-16BE, UTF-32LE,
+ UTF-32BE, encoding internally to UTF-8.
+
+=cut
+
+our @ISA = qw(Exporter);
+our @EXPORT = qw(encode_json decode_json to_json from_json);
+
+sub to_json($@) {
+ if ($] >= 5.008) {
+ require Carp;
+ Carp::croak ("Cpanel::JSON::XS::to_json has been renamed to encode_json,".
+ " either downgrade to pre-2.0 versions of Cpanel::JSON::XS or".
+ " rename the call");
+ } else {
+ _to_json(@_);
+ }
+}
+
+sub from_json($@) {
+ if ($] >= 5.008) {
+ require Carp;
+ Carp::croak ("Cpanel::JSON::XS::from_json has been renamed to decode_json,".
+ " either downgrade to pre-2.0 versions of Cpanel::JSON::XS or".
+ " rename the call");
+ } else {
+ _from_json(@_);
+ }
+}
+
+use Exporter;
+use XSLoader;
+
+=head1 FUNCTIONAL INTERFACE
+
+The following convenience methods are provided by this module. They are
+exported by default:
+
+=over 4
+
+=item $json_text = encode_json $perl_scalar, [json_type]
+
+Converts the given Perl data structure to a UTF-8 encoded, binary string
+(that is, the string contains octets only). Croaks on error.
+
+This function call is functionally identical to:
+
+ $json_text = Cpanel::JSON::XS->new->utf8->encode ($perl_scalar)
+
+Except being faster.
+
+For the type argument see L<Cpanel::JSON::XS::Type>.
+
+=item $perl_scalar = decode_json $json_text [, $allow_nonref ]
+
+The opposite of C<encode_json>: expects an UTF-8 (binary) string of an
+json reference and tries to parse that as an UTF-8 encoded JSON text,
+returning the resulting reference. Croaks on error.
+
+This function call is functionally identical to:
+
+ $perl_scalar = Cpanel::JSON::XS->new->utf8->decode ($json_text)
+
+except being faster.
+
+Note that older decode_json versions in Cpanel::JSON::XS older than
+3.0116 and JSON::XS did not set allow_nonref but allowed them due to a
+bug in the decoder.
+
+If the new optional $allow_nonref argument is set and not false, the
+allow_nonref option will be set and the function will act is described
+as in the relaxed RFC 7159 allowing all values such as objects,
+arrays, strings, numbers, "null", "true", and "false".
+
+=item $is_boolean = Cpanel::JSON::XS::is_bool $scalar
+
+Returns true if the passed scalar represents either C<JSON::XS::true>
+or C<JSON::XS::false>, two constants that act like C<1> and C<0>,
+respectively and are used to represent JSON C<true> and C<false>
+values in Perl.
+
+See MAPPING, below, for more information on how JSON values are mapped
+to Perl.
+
+=back
+
+=head1 DEPRECATED FUNCTIONS
+
+=over
+
+=item from_json
+
+from_json has been renamed to decode_json
+
+=item to_json
+
+to_json has been renamed to encode_json
+
+=back
+
+
+=head1 A FEW NOTES ON UNICODE AND PERL
+
+Since this often leads to confusion, here are a few very clear words on
+how Unicode works in Perl, modulo bugs.
+
+=over 4
+
+=item 1. Perl strings can store characters with ordinal values > 255.
+
+This enables you to store Unicode characters as single characters in a
+Perl string - very natural.
+
+=item 2. Perl does I<not> associate an encoding with your strings.
+
+... until you force it to, e.g. when matching it against a regex, or
+printing the scalar to a file, in which case Perl either interprets
+your string as locale-encoded text, octets/binary, or as Unicode,
+depending on various settings. In no case is an encoding stored
+together with your data, it is I<use> that decides encoding, not any
+magical meta data.
+
+=item 3. The internal utf-8 flag has no meaning with regards to the
+encoding of your string.
+
+=item 4. A "Unicode String" is simply a string where each character
+can be validly interpreted as a Unicode code point.
+
+If you have UTF-8 encoded data, it is no longer a Unicode string, but
+a Unicode string encoded in UTF-8, giving you a binary string.
+
+=item 5. A string containing "high" (> 255) character values is I<not>
+a UTF-8 string.
+
+=item 6. Unicode noncharacters only warn, as in core.
+
+The 66 Unicode noncharacters U+FDD0..U+FDEF, and U+*FFFE, U+*FFFF just
+warn, see L<http://www.unicode.org/versions/corrigendum9.html>. But
+illegal surrogate pairs fail to parse.
+
+=item 7. Raw non-Unicode characters above U+10FFFF are disallowed.
+
+Raw non-Unicode characters outside the valid unicode range fail to
+parse, because "A string is a sequence of zero or more Unicode
+characters" RFC 7159 section 1 and "JSON text SHALL be encoded in
+Unicode RFC 7159 section 8.1. We use now the UTF8_DISALLOW_SUPER
+flag when parsing unicode.
+
+=back
+
+I hope this helps :)
+
+
+=head1 OBJECT-ORIENTED INTERFACE
+
+The object oriented interface lets you configure your own encoding or
+decoding style, within the limits of supported formats.
+
+=over 4
+
+=item $json = new Cpanel::JSON::XS
+
+Creates a new JSON object that can be used to de/encode JSON
+strings. All boolean flags described below are by default I<disabled>.
+
+The mutators for flags all return the JSON object again and thus calls can
+be chained:
+
+ my $json = Cpanel::JSON::XS->new->utf8->space_after->encode ({a => [1,2]})
+ => {"a": [1, 2]}
+
+=item $json = $json->ascii ([$enable])
+
+=item $enabled = $json->get_ascii
+
+If C<$enable> is true (or missing), then the C<encode> method will not
+generate characters outside the code range C<0..127> (which is ASCII). Any
+Unicode characters outside that range will be escaped using either a
+single C<\uXXXX> (BMP characters) or a double C<\uHHHH\uLLLLL> escape sequence,
+as per RFC4627. The resulting encoded JSON text can be treated as a native
+Unicode string, an ascii-encoded, latin1-encoded or UTF-8 encoded string,
+or any other superset of ASCII.
+
+If C<$enable> is false, then the C<encode> method will not escape Unicode
+characters unless required by the JSON syntax or other flags. This results
+in a faster and more compact format.
+
+See also the section I<ENCODING/CODESET FLAG NOTES> later in this
+document.
+
+The main use for this flag is to produce JSON texts that can be
+transmitted over a 7-bit channel, as the encoded JSON texts will not
+contain any 8 bit characters.
+
+ Cpanel::JSON::XS->new->ascii (1)->encode ([chr 0x10401])
+ => ["\ud801\udc01"]
+
+=item $json = $json->latin1 ([$enable])
+
+=item $enabled = $json->get_latin1
+
+If C<$enable> is true (or missing), then the C<encode> method will encode
+the resulting JSON text as latin1 (or ISO-8859-1), escaping any characters
+outside the code range C<0..255>. The resulting string can be treated as a
+latin1-encoded JSON text or a native Unicode string. The C<decode> method
+will not be affected in any way by this flag, as C<decode> by default
+expects Unicode, which is a strict superset of latin1.
+
+If C<$enable> is false, then the C<encode> method will not escape Unicode
+characters unless required by the JSON syntax or other flags.
+
+See also the section I<ENCODING/CODESET FLAG NOTES> later in this
+document.
+
+The main use for this flag is efficiently encoding binary data as JSON
+text, as most octets will not be escaped, resulting in a smaller encoded
+size. The disadvantage is that the resulting JSON text is encoded
+in latin1 (and must correctly be treated as such when storing and
+transferring), a rare encoding for JSON. It is therefore most useful when
+you want to store data structures known to contain binary data efficiently
+in files or databases, not when talking to other JSON encoders/decoders.
+
+ Cpanel::JSON::XS->new->latin1->encode (["\x{89}\x{abc}"]
+ => ["\x{89}\\u0abc"] # (perl syntax, U+abc escaped, U+89 not)
+
+
+=item $json = $json->binary ([$enable])
+
+=item $enabled = $json = $json->get_binary
+
+If the C<$enable> argument is true (or missing), then the C<encode>
+method will not try to detect an UTF-8 encoding in any JSON string, it
+will strictly interpret it as byte sequence. The result might contain
+new C<\xNN> sequences, which is B<unparsable JSON>. The C<decode>
+method forbids C<\uNNNN> sequences and accepts C<\xNN> and octal
+C<\NNN> sequences.
+
+There is also a special logic for perl 5.6 and utf8. 5.6 encodes any
+string to utf-8 automatically when seeing a codepoint >= C<0x80> and
+< C<0x100>. With the binary flag enabled decode the perl utf8 encoded
+string to the original byte encoding and encode this with C<\xNN>
+escapes. This will result to the same encodings as with newer
+perls. But note that binary multi-byte codepoints with 5.6 will
+result in C<illegal unicode character in binary string> errors,
+unlike with newer perls.
+
+If C<$enable> is false, then the C<encode> method will smartly try to
+detect Unicode characters unless required by the JSON syntax or other
+flags and hex and octal sequences are forbidden.
+
+See also the section I<ENCODING/CODESET FLAG NOTES> later in this
+document.
+
+The main use for this flag is to avoid the smart unicode detection and
+possible double encoding. The disadvantage is that the resulting JSON
+text is encoded in new C<\xNN> and in latin1 characters and must
+correctly be treated as such when storing and transferring, a rare
+encoding for JSON. It will produce non-readable JSON strings in the
+browser. It is therefore most useful when you want to store data
+structures known to contain binary data efficiently in files or
+databases, not when talking to other JSON encoders/decoders. The
+binary decoding method can also be used when an encoder produced a
+non-JSON conformant hex or octal encoding C<\xNN> or C<\NNN>.
+
+ Cpanel::JSON::XS->new->binary->encode (["\x{89}\x{abc}"])
+ 5.6: Error: malformed or illegal unicode character in binary string
+ >=5.8: ['\x89\xe0\xaa\xbc']
+
+ Cpanel::JSON::XS->new->binary->encode (["\x{89}\x{bc}"])
+ => ["\x89\xbc"]
+
+ Cpanel::JSON::XS->new->binary->decode (["\x89\ua001"])
+ Error: malformed or illegal unicode character in binary string
+
+ Cpanel::JSON::XS->new->decode (["\x89"])
+ Error: illegal hex character in non-binary string
+
+
+=item $json = $json->utf8 ([$enable])
+
+=item $enabled = $json->get_utf8
+
+If C<$enable> is true (or missing), then the C<encode> method will encode
+the JSON result into UTF-8, as required by many protocols, while the
+C<decode> method expects to be handled an UTF-8-encoded string. Please
+note that UTF-8-encoded strings do not contain any characters outside the
+range C<0..255>, they are thus useful for bytewise/binary I/O. In future
+versions, enabling this option might enable autodetection of the UTF-16
+and UTF-32 encoding families, as described in RFC4627.
+
+If C<$enable> is false, then the C<encode> method will return the JSON
+string as a (non-encoded) Unicode string, while C<decode> expects thus a
+Unicode string. Any decoding or encoding (e.g. to UTF-8 or UTF-16) needs
+to be done yourself, e.g. using the Encode module.
+
+See also the section I<ENCODING/CODESET FLAG NOTES> later in this
+document.
+
+Example, output UTF-16BE-encoded JSON:
+
+ use Encode;
+ $jsontext = encode "UTF-16BE", Cpanel::JSON::XS->new->encode ($object);
+
+Example, decode UTF-32LE-encoded JSON:
+
+ use Encode;
+ $object = Cpanel::JSON::XS->new->decode (decode "UTF-32LE", $jsontext);
+
+=item $json = $json->pretty ([$enable])
+
+This enables (or disables) all of the C<indent>, C<space_before> and
+C<space_after> (and in the future possibly more) flags in one call to
+generate the most readable (or most compact) form possible.
+
+Example, pretty-print some simple structure:
+
+ my $json = Cpanel::JSON::XS->new->pretty(1)->encode ({a => [1,2]})
+ =>
+ {
+ "a" : [
+ 1,
+ 2
+ ]
+ }
+
+
+=item $json = $json->indent ([$enable])
+
+=item $enabled = $json->get_indent
+
+If C<$enable> is true (or missing), then the C<encode> method will use
+a multiline format as output, putting every array member or
+object/hash key-value pair into its own line, indenting them properly.
+
+If C<$enable> is false, no newlines or indenting will be produced, and the
+resulting JSON text is guaranteed not to contain any C<newlines>.
+
+This setting has no effect when decoding JSON texts.
+
+=item $json = $json->indent_length([$number_of_spaces])
+
+=item $length = $json->get_indent_length()
+
+Set the indent length (default C<3>).
+This option is only useful when you also enable indent or pretty.
+The acceptable range is from 0 (no indentation) to 15
+
+=item $json = $json->space_before ([$enable])
+
+=item $enabled = $json->get_space_before
+
+If C<$enable> is true (or missing), then the C<encode> method will add an extra
+optional space before the C<:> separating keys from values in JSON objects.
+
+If C<$enable> is false, then the C<encode> method will not add any extra
+space at those places.
+
+This setting has no effect when decoding JSON texts. You will also
+most likely combine this setting with C<space_after>.
+
+Example, space_before enabled, space_after and indent disabled:
+
+ {"key" :"value"}
+
+=item $json = $json->space_after ([$enable])
+
+=item $enabled = $json->get_space_after
+
+If C<$enable> is true (or missing), then the C<encode> method will add
+an extra optional space after the C<:> separating keys from values in
+JSON objects and extra whitespace after the C<,> separating key-value
+pairs and array members.
+
+If C<$enable> is false, then the C<encode> method will not add any extra
+space at those places.
+
+This setting has no effect when decoding JSON texts.
+
+Example, space_before and indent disabled, space_after enabled:
+
+ {"key": "value"}
+
+=item $json = $json->relaxed ([$enable])
+
+=item $enabled = $json->get_relaxed
+
+If C<$enable> is true (or missing), then C<decode> will accept some
+extensions to normal JSON syntax (see below). C<encode> will not be
+affected in anyway. I<Be aware that this option makes you accept invalid
+JSON texts as if they were valid!>. I suggest only to use this option to
+parse application-specific files written by humans (configuration files,
+resource files etc.)
+
+If C<$enable> is false (the default), then C<decode> will only accept
+valid JSON texts.
+
+Currently accepted extensions are:
+
+=over 4
+
+=item * list items can have an end-comma
+
+JSON I<separates> array elements and key-value pairs with commas. This
+can be annoying if you write JSON texts manually and want to be able to
+quickly append elements, so this extension accepts comma at the end of
+such items not just between them:
+
+ [
+ 1,
+ 2, <- this comma not normally allowed
+ ]
+ {
+ "k1": "v1",
+ "k2": "v2", <- this comma not normally allowed
+ }
+
+=item * shell-style '#'-comments
+
+Whenever JSON allows whitespace, shell-style comments are additionally
+allowed. They are terminated by the first carriage-return or line-feed
+character, after which more white-space and comments are allowed.
+
+ [
+ 1, # this comment not allowed in JSON
+ # neither this one...
+ ]
+
+=item * literal ASCII TAB characters in strings
+
+Literal ASCII TAB characters are now allowed in strings (and treated as
+C<\t>) in relaxed mode. Despite JSON mandates, that TAB character is
+substituted for "\t" sequence.
+
+ [
+ "Hello\tWorld",
+ "Hello<TAB>World", # literal <TAB> would not normally be allowed
+ ]
+
+=item * allow_singlequote
+
+Single quotes are accepted instead of double quotes. See the
+L</allow_singlequote> option.
+
+ { "foo":'bar' }
+ { 'foo':"bar" }
+ { 'foo':'bar' }
+
+=item * allow_barekey
+
+Accept unquoted object keys instead of with mandatory double quotes. See the
+L</allow_barekey> option.
+
+ { foo:"bar" }
+
+=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>:
+RFC 7159 section 4: "The names within an object should be unique."
+See the L</allow_dupkeys> option.
+
+=back
+
+
+=item $json = $json->canonical ([$enable])
+
+=item $enabled = $json->get_canonical
+
+If C<$enable> is true (or missing), then the C<encode> method will
+output JSON objects by sorting their keys. This is adding a
+comparatively high overhead.
+
+If C<$enable> is false, then the C<encode> method will output key-value
+pairs in the order Perl stores them (which will likely change between runs
+of the same script, and can change even within the same run from 5.18
+onwards).
+
+This option is useful if you want the same data structure to be encoded as
+the same JSON text (given the same overall settings). If it is disabled,
+the same hash might be encoded differently even if contains the same data,
+as key-value pairs have no inherent ordering in Perl.
+
+This setting has no effect when decoding JSON texts.
+
+This setting has currently no effect on tied hashes.
+
+
+=item $json = $json->sort_by (undef, 0, 1 or a block)
+
+This currently only (un)sets the C<canonical> option, and ignores
+custom sort blocks.
+
+This setting has no effect when decoding JSON texts.
+
+This setting has currently no effect on tied hashes.
+
+
+=item $json = $json->escape_slash ([$enable])
+
+=item $enabled = $json->get_escape_slash
+
+According to the JSON Grammar, the I<forward slash> character (U+002F)
+C<"/"> need to be escaped. But by default strings are encoded without
+escaping slashes in all perl JSON encoders.
+
+If C<$enable> is true (or missing), then C<encode> will escape slashes,
+C<"\/">.
+
+This setting has no effect when decoding JSON texts.
+
+
+=item $json = $json->unblessed_bool ([$enable])
+
+=item $enabled = $json->get_unblessed_bool
+
+ $json = $json->unblessed_bool([$enable])
+
+If C<$enable> is true (or missing), then C<decode> will return
+Perl non-object boolean variables (1 and 0) for JSON booleans
+(C<true> and C<false>). If C<$enable> is false, then C<decode>
+will return C<Cpanel::JSON::XS::Boolean> objects for JSON booleans.
+
+
+=item $json = $json->allow_singlequote ([$enable])
+
+=item $enabled = $json->get_allow_singlequote
+
+ $json = $json->allow_singlequote([$enable])
+
+If C<$enable> is true (or missing), then C<decode> will accept
+JSON strings quoted by single quotations that are invalid JSON
+format.
+
+ $json->allow_singlequote->decode({"foo":'bar'});
+ $json->allow_singlequote->decode({'foo':"bar"});
+ $json->allow_singlequote->decode({'foo':'bar'});
+
+This is also enabled with C<relaxed>.
+As same as the C<relaxed> option, this option may be used to parse
+application-specific files written by humans.
+
+
+=item $json = $json->allow_barekey ([$enable])
+
+=item $enabled = $json->get_allow_barekey
+
+ $json = $json->allow_barekey([$enable])
+
+If C<$enable> is true (or missing), then C<decode> will accept
+bare keys of JSON object that are invalid JSON format.
+
+Same as with the C<relaxed> option, this option may be used to parse
+application-specific files written by humans.
+
+ $json->allow_barekey->decode('{foo:"bar"}');
+
+=item $json = $json->allow_bignum ([$enable])
+
+=item $enabled = $json->get_allow_bignum
+
+ $json = $json->allow_bignum([$enable])
+
+If C<$enable> is true (or missing), then C<decode> will convert
+the big integer Perl cannot handle as integer into a L<Math::BigInt>
+object and convert a floating number (any) into a L<Math::BigFloat>.
+
+On the contrary, C<encode> converts C<Math::BigInt> objects and
+C<Math::BigFloat> objects into JSON numbers with C<allow_blessed>
+enable.
+
+ $json->allow_nonref->allow_blessed->allow_bignum;
+ $bigfloat = $json->decode('2.000000000000000000000000001');
+ print $json->encode($bigfloat);
+ # => 2.000000000000000000000000001
+
+See L</MAPPING> about the normal conversion of JSON number.
+
+
+=item $json = $json->allow_bigint ([$enable])
+
+This option is obsolete and replaced by allow_bignum.
+
+
+=item $json = $json->allow_nonref ([$enable])
+
+=item $enabled = $json->get_allow_nonref
+
+If C<$enable> is true (or missing), then the C<encode> method can
+convert a non-reference into its corresponding string, number or null
+JSON value, which is an extension to RFC4627. Likewise, C<decode> will
+accept those JSON values instead of croaking.
+
+If C<$enable> is false, then the C<encode> method will croak if it isn't
+passed an arrayref or hashref, as JSON texts must either be an object
+or array. Likewise, C<decode> will croak if given something that is not a
+JSON object or array.
+
+Example, encode a Perl scalar as JSON value with enabled C<allow_nonref>,
+resulting in an invalid JSON text:
+
+ Cpanel::JSON::XS->new->allow_nonref->encode ("Hello, World!")
+ => "Hello, World!"
+
+=item $json = $json->allow_unknown ([$enable])
+
+=item $enabled = $json->get_allow_unknown
+
+If C<$enable> is true (or missing), then C<encode> will I<not> throw an
+exception when it encounters values it cannot represent in JSON (for
+example, filehandles) but instead will encode a JSON C<null> value. Note
+that blessed objects are not included here and are handled separately by
+c<allow_nonref>.
+
+If C<$enable> is false (the default), then C<encode> will throw an
+exception when it encounters anything it cannot encode as JSON.
+
+This option does not affect C<decode> in any way, and it is recommended to
+leave it off unless you know your communications partner.
+
+=item $json = $json->allow_stringify ([$enable])
+
+=item $enabled = $json->get_allow_stringify
+
+If C<$enable> is true (or missing), then C<encode> will stringify the
+non-object perl value or reference. Note that blessed objects are not
+included here and are handled separately by C<allow_blessed> and
+C<convert_blessed>. String references are stringified to the string
+value, other references as in perl.
+
+This option does not affect C<decode> in any way.
+
+This option is special to this module, it is not supported by other
+encoders. So it is not recommended to use it.
+
+=item $json = $json->allow_dupkeys ([$enable])
+
+=item $enabled = $json->get_allow_dupkeys
+
+If C<$enable> is true (or missing), then the C<decode> method will not
+die when it encounters duplicate keys in a hash.
+C<allow_dupkeys> is also enabled in the C<relaxed> mode.
+
+The JSON spec allows duplicate name in objects but recommends to
+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>:
+RFC 7159 section 4: "The names within an object should be unique."
+
+=item $json = $json->allow_blessed ([$enable])
+
+=item $enabled = $json->get_allow_blessed
+
+If C<$enable> is true (or missing), then the C<encode> method will not
+barf when it encounters a blessed reference. Instead, the value of the
+B<convert_blessed> option will decide whether C<null> (C<convert_blessed>
+disabled or no C<TO_JSON> method found) or a representation of the
+object (C<convert_blessed> enabled and C<TO_JSON> method found) is being
+encoded. Has no effect on C<decode>.
+
+If C<$enable> is false (the default), then C<encode> will throw an
+exception when it encounters a blessed object.
+
+This setting has no effect on C<decode>.
+
+=item $json = $json->convert_blessed ([$enable])
+
+=item $enabled = $json->get_convert_blessed
+
+If C<$enable> is true (or missing), then C<encode>, upon encountering a
+blessed object, will check for the availability of the C<TO_JSON> method
+on the object's class. If found, it will be called in scalar context
+and the resulting scalar will be encoded instead of the object. If no
+C<TO_JSON> method is found, a stringification overload method is tried next.
+If both are not found, the value of C<allow_blessed> will decide what
+to do.
+
+The C<TO_JSON> method may safely call die if it wants. If C<TO_JSON>
+returns other blessed objects, those will be handled in the same
+way. C<TO_JSON> must take care of not causing an endless recursion cycle
+(== crash) in this case. The name of C<TO_JSON> was chosen because other
+methods called by the Perl core (== not by the user of the object) are
+usually in upper case letters and to avoid collisions with any C<to_json>
+function or method.
+
+If C<$enable> is false (the default), then C<encode> will not consider
+this type of conversion.
+
+This setting has no effect on C<decode>.
+
+=item $json = $json->allow_tags ([$enable])
+
+=item $enabled = $json->get_allow_tags
+
+See L<OBJECT SERIALIZATION> for details.
+
+If C<$enable> is true (or missing), then C<encode>, upon encountering a
+blessed object, will check for the availability of the C<FREEZE> method on
+the object's class. If found, it will be used to serialize the object into
+a nonstandard tagged JSON value (that JSON decoders cannot decode).
+
+It also causes C<decode> to parse such tagged JSON values and deserialize
+them via a call to the C<THAW> method.
+
+If C<$enable> is false (the default), then C<encode> will not consider
+this type of conversion, and tagged JSON values will cause a parse error
+in C<decode>, as if tags were not part of the grammar.
+
+=item $json = $json->filter_json_object ([$coderef->($hashref)])
+
+When C<$coderef> is specified, it will be called from C<decode> each
+time it decodes a JSON object. The only argument is a reference to the
+newly-created hash. If the code references returns a single scalar (which
+need not be a reference), this value (i.e. a copy of that scalar to avoid
+aliasing) is inserted into the deserialized data structure. If it returns
+an empty list (NOTE: I<not> C<undef>, which is a valid scalar), the
+original deserialized hash will be inserted. This setting can slow down
+decoding considerably.
+
+When C<$coderef> is omitted or undefined, any existing callback will
+be removed and C<decode> will not change the deserialized hash in any
+way.
+
+Example, convert all JSON objects into the integer 5:
+
+ my $js = Cpanel::JSON::XS->new->filter_json_object (sub { 5 });
+ # returns [5]
+ $js->decode ('[{}]')
+ # throw an exception because allow_nonref is not enabled
+ # so a lone 5 is not allowed.
+ $js->decode ('{"a":1, "b":2}');
+
+=item $json = $json->filter_json_single_key_object ($key [=> $coderef->($value)])
+
+Works remotely similar to C<filter_json_object>, but is only called for
+JSON objects having a single key named C<$key>.
+
+This C<$coderef> is called before the one specified via
+C<filter_json_object>, if any. It gets passed the single value in the JSON
+object. If it returns a single value, it will be inserted into the data
+structure. If it returns nothing (not even C<undef> but the empty list),
+the callback from C<filter_json_object> will be called next, as if no
+single-key callback were specified.
+
+If C<$coderef> is omitted or undefined, the corresponding callback will be
+disabled. There can only ever be one callback for a given key.
+
+As this callback gets called less often then the C<filter_json_object>
+one, decoding speed will not usually suffer as much. Therefore, single-key
+objects make excellent targets to serialize Perl objects into, especially
+as single-key JSON objects are as close to the type-tagged value concept
+as JSON gets (it's basically an ID/VALUE tuple). Of course, JSON does not
+support this in any way, so you need to make sure your data never looks
+like a serialized Perl hash.
+
+Typical names for the single object key are C<__class_whatever__>, or
+C<$__dollars_are_rarely_used__$> or C<}ugly_brace_placement>, or even
+things like C<__class_md5sum(classname)__>, to reduce the risk of clashing
+with real hashes.
+
+Example, decode JSON objects of the form C<< { "__widget__" => <id> } >>
+into the corresponding C<< $WIDGET{<id>} >> object:
+
+ # return whatever is in $WIDGET{5}:
+ Cpanel::JSON::XS
+ ->new
+ ->filter_json_single_key_object (__widget__ => sub {
+ $WIDGET{ $_[0] }
+ })
+ ->decode ('{"__widget__": 5')
+
+ # this can be used with a TO_JSON method in some "widget" class
+ # for serialization to json:
+ sub WidgetBase::TO_JSON {
+ my ($self) = @_;
+
+ unless ($self->{id}) {
+ $self->{id} = ..get..some..id..;
+ $WIDGET{$self->{id}} = $self;
+ }
+
+ { __widget__ => $self->{id} }
+ }
+
+=item $json = $json->shrink ([$enable])
+
+=item $enabled = $json->get_shrink
+
+Perl usually over-allocates memory a bit when allocating space for
+strings. This flag optionally resizes strings generated by either
+C<encode> or C<decode> to their minimum size possible. This can save
+memory when your JSON texts are either very very long or you have many
+short strings. It will also try to downgrade any strings to octet-form
+if possible: perl stores strings internally either in an encoding called
+UTF-X or in octet-form. The latter cannot store everything but uses less
+space in general (and some buggy Perl or C code might even rely on that
+internal representation being used).
+
+The actual definition of what shrink does might change in future versions,
+but it will always try to save space at the expense of time.
+
+If C<$enable> is true (or missing), the string returned by C<encode> will
+be shrunk-to-fit, while all strings generated by C<decode> will also be
+shrunk-to-fit.
+
+If C<$enable> is false, then the normal perl allocation algorithms are used.
+If you work with your data, then this is likely to be faster.
+
+In the future, this setting might control other things, such as converting
+strings that look like integers or floats into integers or floats
+internally (there is no difference on the Perl level), saving space.
+
+=item $json = $json->max_depth ([$maximum_nesting_depth])
+
+=item $max_depth = $json->get_max_depth
+
+Sets the maximum nesting level (default C<512>) accepted while encoding
+or decoding. If a higher nesting level is detected in JSON text or a Perl
+data structure, then the encoder and decoder will stop and croak at that
+point.
+
+Nesting level is defined by number of hash- or arrayrefs that the encoder
+needs to traverse to reach a given point or the number of C<{> or C<[>
+characters without their matching closing parenthesis crossed to reach a
+given character in a string.
+
+Setting the maximum depth to one disallows any nesting, so that ensures
+that the object is only a single hash/object or array.
+
+If no argument is given, the highest possible setting will be used, which
+is rarely useful.
+
+Note that nesting is implemented by recursion in C. The default value has
+been chosen to be as large as typical operating systems allow without
+crashing.
+
+See SECURITY CONSIDERATIONS, below, for more info on why this is useful.
+
+=item $json = $json->max_size ([$maximum_string_size])
+
+=item $max_size = $json->get_max_size
+
+Set the maximum length a JSON text may have (in bytes) where decoding is
+being attempted. The default is C<0>, meaning no limit. When C<decode>
+is called on a string that is longer then this many bytes, it will not
+attempt to decode the string but throw an exception. This setting has no
+effect on C<encode> (yet).
+
+If no argument is given, the limit check will be deactivated (same as when
+C<0> is specified).
+
+See L</SECURITY CONSIDERATIONS>, below, for more info on why this is useful.
+
+=item $json->stringify_infnan ([$infnan_mode = 1])
+
+=item $infnan_mode = $json->get_stringify_infnan
+
+Get or set how Cpanel::JSON::XS encodes C<inf>, C<-inf> or C<nan> for numeric
+values. Also qnan, snan or negative nan on some platforms.
+
+C<null>: infnan_mode = 0. Similar to most JSON modules in other languages.
+Always null.
+
+stringified: infnan_mode = 1. As in Mojo::JSON. Platform specific strings.
+Stringified via sprintf(%g), with double quotes.
+
+inf/nan: infnan_mode = 2. As in JSON::XS, and older releases.
+Passes through platform dependent values, invalid JSON. Stringified via
+sprintf(%g), but without double quotes.
+
+"inf/-inf/nan": infnan_mode = 3. Platform independent inf/nan/-inf
+strings. No QNAN/SNAN/negative NAN support, unified to "nan". Much
+easier to detect, but may conflict with valid strings.
+
+=item $json_text = $json->encode ($perl_scalar)
+
+Converts the given Perl data structure (a simple scalar or a reference
+to a hash or array) to its JSON representation. Simple scalars will be
+converted into JSON string or number sequences, while references to
+arrays become JSON arrays and references to hashes become JSON
+objects. Undefined Perl values (e.g. C<undef>) become JSON C<null>
+values. Neither C<true> nor C<false> values will be generated.
+
+=item $perl_scalar = $json->decode ($json_text)
+
+The opposite of C<encode>: expects a JSON text and tries to parse it,
+returning the resulting simple scalar or reference. Croaks on error.
+
+JSON numbers and strings become simple Perl scalars. JSON arrays become
+Perl arrayrefs and JSON objects become Perl hashrefs. C<true> becomes
+C<1>, C<false> becomes C<0> and C<null> becomes C<undef>.
+
+=item ($perl_scalar, $characters) = $json->decode_prefix ($json_text)
+
+This works like the C<decode> method, but instead of raising an exception
+when there is trailing garbage after the first JSON object, it will
+silently stop parsing there and return the number of characters consumed
+so far.
+
+This is useful if your JSON texts are not delimited by an outer protocol
+and you need to know where the JSON text ends.
+
+ Cpanel::JSON::XS->new->decode_prefix ("[1] the tail")
+ => ([1], 3)
+
+=item $json->to_json ($perl_hash_or_arrayref)
+
+Deprecated method for perl 5.8 and newer. Use L<encode_json> instead.
+
+=item $json->from_json ($utf8_encoded_json_text)
+
+Deprecated method for perl 5.8 and newer. Use L<decode_json> instead.
+
+=back
+
+
+=head1 INCREMENTAL PARSING
+
+In some cases, there is the need for incremental parsing of JSON
+texts. While this module always has to keep both JSON text and resulting
+Perl data structure in memory at one time, it does allow you to parse a
+JSON stream incrementally. It does so by accumulating text until it has
+a full JSON object, which it then can decode. This process is similar to
+using C<decode_prefix> to see if a full JSON object is available, but
+is much more efficient (and can be implemented with a minimum of method
+calls).
+
+Cpanel::JSON::XS will only attempt to parse the JSON text once it is
+sure it has enough text to get a decisive result, using a very simple
+but truly incremental parser. This means that it sometimes won't stop
+as early as the full parser, for example, it doesn't detect mismatched
+parentheses. The only thing it guarantees is that it starts decoding
+as soon as a syntactically valid JSON text has been seen. This means
+you need to set resource limits (e.g. C<max_size>) to ensure the
+parser will stop parsing in the presence if syntax errors.
+
+The following methods implement this incremental parser.
+
+=over 4
+
+=item [void, scalar or list context] = $json->incr_parse ([$string])
+
+This is the central parsing function. It can both append new text and
+extract objects from the stream accumulated so far (both of these
+functions are optional).
+
+If C<$string> is given, then this string is appended to the already
+existing JSON fragment stored in the C<$json> object.
+
+After that, if the function is called in void context, it will simply
+return without doing anything further. This can be used to add more text
+in as many chunks as you want.
+
+If the method is called in scalar context, then it will try to extract
+exactly I<one> JSON object. If that is successful, it will return this
+object, otherwise it will return C<undef>. If there is a parse error,
+this method will croak just as C<decode> would do (one can then use
+C<incr_skip> to skip the erroneous part). This is the most common way of
+using the method.
+
+And finally, in list context, it will try to extract as many objects
+from the stream as it can find and return them, or the empty list
+otherwise. For this to work, there must be no separators between the JSON
+objects or arrays, instead they must be concatenated back-to-back. If
+an error occurs, an exception will be raised as in the scalar context
+case. Note that in this case, any previously-parsed JSON texts will be
+lost.
+
+Example: Parse some JSON arrays/objects in a given string and return
+them.
+
+ my @objs = Cpanel::JSON::XS->new->incr_parse ("[5][7][1,2]");
+
+=item $lvalue_string = $json->incr_text (>5.8 only)
+
+This method returns the currently stored JSON fragment as an lvalue, that
+is, you can manipulate it. This I<only> works when a preceding call to
+C<incr_parse> in I<scalar context> successfully returned an object, and
+2. only with Perl >= 5.8
+
+Under all other circumstances you must not call this function (I mean
+it. although in simple tests it might actually work, it I<will> fail
+under real world conditions). As a special exception, you can also
+call this method before having parsed anything.
+
+This function is useful in two cases: a) finding the trailing text after a
+JSON object or b) parsing multiple JSON objects separated by non-JSON text
+(such as commas).
+
+=item $json->incr_skip
+
+This will reset the state of the incremental parser and will remove
+the parsed text from the input buffer so far. This is useful after
+C<incr_parse> died, in which case the input buffer and incremental parser
+state is left unchanged, to skip the text parsed so far and to reset the
+parse state.
+
+The difference to C<incr_reset> is that only text until the parse error
+occurred is removed.
+
+=item $json->incr_reset
+
+This completely resets the incremental parser, that is, after this call,
+it will be as if the parser had never parsed anything.
+
+This is useful if you want to repeatedly parse JSON objects and want to
+ignore any trailing data, which means you have to reset the parser after
+each successful decode.
+
+=back
+
+=head2 LIMITATIONS
+
+All options that affect decoding are supported, except
+C<allow_nonref>. The reason for this is that it cannot be made to work
+sensibly: JSON objects and arrays are self-delimited, i.e. you can
+concatenate them back to back and still decode them perfectly. This
+does not hold true for JSON numbers, however.
+
+For example, is the string C<1> a single JSON number, or is it simply
+the start of C<12>? Or is C<12> a single JSON number, or the
+concatenation of C<1> and C<2>? In neither case you can tell, and this
+is why Cpanel::JSON::XS takes the conservative route and disallows
+this case.
+
+=head2 EXAMPLES
+
+Some examples will make all this clearer. First, a simple example that
+works similarly to C<decode_prefix>: We want to decode the JSON object at
+the start of a string and identify the portion after the JSON object:
+
+ my $text = "[1,2,3] hello";
+
+ my $json = new Cpanel::JSON::XS;
+
+ my $obj = $json->incr_parse ($text)
+ or die "expected JSON object or array at beginning of string";
+
+ my $tail = $json->incr_text;
+ # $tail now contains " hello"
+
+Easy, isn't it?
+
+Now for a more complicated example: Imagine a hypothetical protocol where
+you read some requests from a TCP stream, and each request is a JSON
+array, without any separation between them (in fact, it is often useful to
+use newlines as "separators", as these get interpreted as whitespace at
+the start of the JSON text, which makes it possible to test said protocol
+with C<telnet>...).
+
+Here is how you'd do it (it is trivial to write this in an event-based
+manner):
+
+ my $json = new Cpanel::JSON::XS;
+
+ # read some data from the socket
+ while (sysread $socket, my $buf, 4096) {
+
+ # split and decode as many requests as possible
+ for my $request ($json->incr_parse ($buf)) {
+ # act on the $request
+ }
+ }
+
+Another complicated example: Assume you have a string with JSON objects
+or arrays, all separated by (optional) comma characters (e.g. C<[1],[2],
+[3]>). To parse them, we have to skip the commas between the JSON texts,
+and here is where the lvalue-ness of C<incr_text> comes in useful:
+
+ my $text = "[1],[2], [3]";
+ my $json = new Cpanel::JSON::XS;
+
+ # void context, so no parsing done
+ $json->incr_parse ($text);
+
+ # now extract as many objects as possible. note the
+ # use of scalar context so incr_text can be called.
+ while (my $obj = $json->incr_parse) {
+ # do something with $obj
+
+ # now skip the optional comma
+ $json->incr_text =~ s/^ \s* , //x;
+ }
+
+Now lets go for a very complex example: Assume that you have a gigantic
+JSON array-of-objects, many gigabytes in size, and you want to parse it,
+but you cannot load it into memory fully (this has actually happened in
+the real world :).
+
+Well, you lost, you have to implement your own JSON parser. But
+Cpanel::JSON::XS can still help you: You implement a (very simple)
+array parser and let JSON decode the array elements, which are all
+full JSON objects on their own (this wouldn't work if the array
+elements could be JSON numbers, for example):
+
+ my $json = new Cpanel::JSON::XS;
+
+ # open the monster
+ open my $fh, "<bigfile.json"
+ or die "bigfile: $!";
+
+ # first parse the initial "["
+ for (;;) {
+ sysread $fh, my $buf, 65536
+ or die "read error: $!";
+ $json->incr_parse ($buf); # void context, so no parsing
+
+ # Exit the loop once we found and removed(!) the initial "[".
+ # In essence, we are (ab-)using the $json object as a simple scalar
+ # we append data to.
+ last if $json->incr_text =~ s/^ \s* \[ //x;
+ }
+
+ # now we have the skipped the initial "[", so continue
+ # parsing all the elements.
+ for (;;) {
+ # in this loop we read data until we got a single JSON object
+ for (;;) {
+ if (my $obj = $json->incr_parse) {
+ # do something with $obj
+ last;
+ }
+
+ # add more data
+ sysread $fh, my $buf, 65536
+ or die "read error: $!";
+ $json->incr_parse ($buf); # void context, so no parsing
+ }
+
+ # in this loop we read data until we either found and parsed the
+ # separating "," between elements, or the final "]"
+ for (;;) {
+ # first skip whitespace
+ $json->incr_text =~ s/^\s*//;
+
+ # if we find "]", we are done
+ if ($json->incr_text =~ s/^\]//) {
+ print "finished.\n";
+ exit;
+ }
+
+ # if we find ",", we can continue with the next element
+ if ($json->incr_text =~ s/^,//) {
+ last;
+ }
+
+ # if we find anything else, we have a parse error!
+ if (length $json->incr_text) {
+ die "parse error near ", $json->incr_text;
+ }
+
+ # else add more data
+ sysread $fh, my $buf, 65536
+ or die "read error: $!";
+ $json->incr_parse ($buf); # void context, so no parsing
+ }
+
+This is a complex example, but most of the complexity comes from the fact
+that we are trying to be correct (bear with me if I am wrong, I never ran
+the above example :).
+
+=head1 BOM
+
+Detect all unicode B<Byte Order Marks> on decode.
+Which are UTF-8, UTF-16LE, UTF-16BE, UTF-32LE and UTF-32BE.
+
+B<Warning>: With perls older than 5.20 you need load the Encode module
+before loading a multibyte BOM, i.e. >= UTF-16. Otherwise an error is
+thrown. This is an implementation limitation and might get fixed later.
+
+See L<https://tools.ietf.org/html/rfc7159#section-8.1>
+I<"JSON text SHALL be encoded in UTF-8, UTF-16, or UTF-32.">
+
+I<"Implementations MUST NOT add a byte order mark to the beginning of a
+JSON text", "implementations (...) MAY ignore the presence of a byte
+order mark rather than treating it as an error".>
+
+See also L<http://www.unicode.org/faq/utf_bom.html#BOM>.
+
+Beware that Cpanel::JSON::XS is currently the only JSON module which
+does accept and decode a BOM.
+
+The latest JSON spec
+L<https://www.greenbytes.de/tech/webdav/rfc8259.html#character.encoding>
+forbid the usage of UTF-16 or UTF-32, the character encoding is UTF-8.
+Thus in subsequent updates BOM's of UTF-16 or UTF-32 will throw an error.
+
+=head1 MAPPING
+
+This section describes how Cpanel::JSON::XS maps Perl values to JSON
+values and vice versa. These mappings are designed to "do the right
+thing" in most circumstances automatically, preserving round-tripping
+characteristics (what you put in comes out as something equivalent).
+
+For the more enlightened: note that in the following descriptions,
+lowercase I<perl> refers to the Perl interpreter, while uppercase I<Perl>
+refers to the abstract Perl language itself.
+
+
+=head2 JSON -> PERL
+
+=over 4
+
+=item object
+
+A JSON object becomes a reference to a hash in Perl. No ordering of object
+keys is preserved (JSON does not preserve object key ordering itself).
+
+=item array
+
+A JSON array becomes a reference to an array in Perl.
+
+=item string
+
+A JSON string becomes a string scalar in Perl - Unicode codepoints in JSON
+are represented by the same codepoints in the Perl string, so no manual
+decoding is necessary.
+
+=item number
+
+A JSON number becomes either an integer, numeric (floating point) or
+string scalar in perl, depending on its range and any fractional parts. On
+the Perl level, there is no difference between those as Perl handles all
+the conversion details, but an integer may take slightly less memory and
+might represent more values exactly than floating point numbers.
+
+If the number consists of digits only, Cpanel::JSON::XS will try to
+represent it as an integer value. If that fails, it will try to
+represent it as a numeric (floating point) value if that is possible
+without loss of precision. Otherwise it will preserve the number as a
+string value (in which case you lose roundtripping ability, as the
+JSON number will be re-encoded to a JSON string).
+
+Numbers containing a fractional or exponential part will always be
+represented as numeric (floating point) values, possibly at a loss of
+precision (in which case you might lose perfect roundtripping ability, but
+the JSON number will still be re-encoded as a JSON number).
+
+Note that precision is not accuracy - binary floating point values
+cannot represent most decimal fractions exactly, and when converting
+from and to floating point, C<Cpanel::JSON::XS> only guarantees precision
+up to but not including the least significant bit.
+
+=item true, false
+
+These JSON atoms become C<Cpanel::JSON::XS::true> and
+C<Cpanel::JSON::XS::false>, respectively. They are C<JSON::PP::Boolean>
+objects and are overloaded to act almost exactly like the numbers C<1>
+and C<0>. You can check whether a scalar is a JSON boolean by using
+the C<Cpanel::JSON::XS::is_bool> function.
+
+The other round, from perl to JSON, C<!0> which is represented as
+C<yes> becomes C<true>, and C<!1> which is represented as
+C<no> becomes C<false>.
+
+Via L<Cpanel::JSON::XS::Type> you can now even force negation in C<encode>,
+without overloading of C<!>:
+
+ my $false = Cpanel::JSON::XS::false;
+ print($json->encode([!$false], [JSON_TYPE_BOOL]));
+ => [true]
+
+=item null
+
+A JSON null atom becomes C<undef> in Perl.
+
+=item shell-style comments (C<< # I<text> >>)
+
+As a nonstandard extension to the JSON syntax that is enabled by the
+C<relaxed> setting, shell-style comments are allowed. They can start
+anywhere outside strings and go till the end of the line.
+
+=item tagged values (C<< (I<tag>)I<value> >>).
+
+Another nonstandard extension to the JSON syntax, enabled with the
+C<allow_tags> setting, are tagged values. In this implementation, the
+I<tag> must be a perl package/class name encoded as a JSON string, and the
+I<value> must be a JSON array encoding optional constructor arguments.
+
+See L<OBJECT SERIALIZATION>, below, for details.
+
+=back
+
+
+=head2 PERL -> JSON
+
+The mapping from Perl to JSON is slightly more difficult, as Perl is a
+truly typeless language, so we can only guess which JSON type is meant by
+a Perl value.
+
+=over 4
+
+=item hash references
+
+Perl hash references become JSON objects. As there is no inherent ordering
+in hash keys (or JSON objects), they will usually be encoded in a
+pseudo-random order that can change between runs of the same program but
+stays generally the same within a single run of a program. Cpanel::JSON::XS can
+optionally sort the hash keys (determined by the I<canonical> flag), so
+the same datastructure will serialize to the same JSON text (given same
+settings and version of Cpanel::JSON::XS), but this incurs a runtime overhead
+and is only rarely useful, e.g. when you want to compare some JSON text
+against another for equality.
+
+=item array references
+
+Perl array references become JSON arrays.
+
+=item other references
+
+Other unblessed references are generally not allowed and will cause an
+exception to be thrown, except for references to the integers C<0> and
+C<1>, which get turned into C<false> and C<true> atoms in JSON.
+
+With the option C<allow_stringify>, you can ignore the exception and return
+the stringification of the perl value.
+
+With the option C<allow_unknown>, you can ignore the exception and
+return C<null> instead.
+
+ encode_json [\"x"] # => cannot encode reference to scalar 'SCALAR(0x..)'
+ # unless the scalar is 0 or 1
+ encode_json [\0, \1] # yields [false,true]
+
+ allow_stringify->encode_json [\"x"] # yields "x" unlike JSON::PP
+ allow_unknown->encode_json [\"x"] # yields null as in JSON::PP
+
+=item Cpanel::JSON::XS::true, Cpanel::JSON::XS::false
+
+These special values become JSON true and JSON false values,
+respectively. You can also use C<\1> and C<\0> or C<!0> and C<!1>
+directly if you want.
+
+ encode_json [Cpanel::JSON::XS::true, Cpanel::JSON::XS::true] # yields [false,true]
+ encode_json [!1, !0] # yields [false,true]
+
+eq/ne comparisons with true, false:
+
+false is eq to the empty string or the string 'false' or the special
+empty string C<!!0>, i.e. C<SV_NO>, or the numbers 0 or 0.0.
+
+true is eq to the string 'true' or to the special string C<!0>
+(i.e. C<SV_YES>) or to the numbers 1 or 1.0.
+
+=item blessed objects
+
+Blessed objects are not directly representable in JSON, but
+C<Cpanel::JSON::XS> allows various optional ways of handling
+objects. See L<OBJECT SERIALIZATION>, below, for details.
+
+See the C<allow_blessed> and C<convert_blessed> methods on various
+options on how to deal with this: basically, you can choose between
+throwing an exception, encoding the reference as if it weren't
+blessed, use the objects overloaded stringification method or provide
+your own serializer method.
+
+=item simple scalars
+
+Simple Perl scalars (any scalar that is not a reference) are the most
+difficult objects to encode: Cpanel::JSON::XS will encode undefined
+scalars or inf/nan as JSON C<null> values, scalars that have last been
+used in a string context before encoding as JSON strings, and anything
+else as number value:
+
+ # dump as number
+ encode_json [2] # yields [2]
+ encode_json [-3.0e17] # yields [-3e+17]
+ my $value = 5; encode_json [$value] # yields [5]
+
+ # used as string, but the two representations are for the same number
+ print $value;
+ encode_json [$value] # yields [5]
+
+ # used as different string (non-matching dual-var)
+ my $str = '0 but true';
+ my $num = 1 + $str;
+ encode_json [$num, $str] # yields [1,"0 but true"]
+
+ # undef becomes null
+ encode_json [undef] # yields [null]
+
+ # inf or nan becomes null, unless you answered
+ # "Do you want to handle inf/nan as strings" with yes
+ encode_json [9**9**9] # yields [null]
+
+You can force the type to be a JSON string by stringifying it:
+
+ my $x = 3.1; # some variable containing a number
+ "$x"; # stringified
+ $x .= ""; # another, more awkward way to stringify
+ print $x; # perl does it for you, too, quite often
+
+You can force the type to be a JSON number by numifying it:
+
+ my $x = "3"; # some variable containing a string
+ $x += 0; # numify it, ensuring it will be dumped as a number
+ $x *= 1; # same thing, the choice is yours.
+
+Note that numerical precision has the same meaning as under Perl (so
+binary to decimal conversion follows the same rules as in Perl, which
+can differ to other languages). Also, your perl interpreter might expose
+extensions to the floating point numbers of your platform, such as
+infinities or NaN's - these cannot be represented in JSON, and thus
+null is returned instead. Optionally you can configure it to stringify
+inf and nan values.
+
+=back
+
+=head2 OBJECT SERIALIZATION
+
+As JSON cannot directly represent Perl objects, you have to choose between
+a pure JSON representation (without the ability to deserialize the object
+automatically again), and a nonstandard extension to the JSON syntax,
+tagged values.
+
+=head3 SERIALIZATION
+
+What happens when C<Cpanel::JSON::XS> encounters a Perl object depends
+on the C<allow_blessed>, C<convert_blessed> and C<allow_tags>
+settings, which are used in this order:
+
+=over 4
+
+=item 1. C<allow_tags> is enabled and the object has a C<FREEZE> method.
+
+In this case, C<Cpanel::JSON::XS> uses the L<Types::Serialiser> object
+serialization protocol to create a tagged JSON value, using a nonstandard
+extension to the JSON syntax.
+
+This works by invoking the C<FREEZE> method on the object, with the first
+argument being the object to serialize, and the second argument being the
+constant string C<JSON> to distinguish it from other serializers.
+
+The C<FREEZE> method can return any number of values (i.e. zero or
+more). These values and the paclkage/classname of the object will then be
+encoded as a tagged JSON value in the following format:
+
+ ("classname")[FREEZE return values...]
+
+e.g.:
+
+ ("URI")["http://www.google.com/"]
+ ("MyDate")[2013,10,29]
+ ("ImageData::JPEG")["Z3...VlCg=="]
+
+For example, the hypothetical C<My::Object> C<FREEZE> method might use the
+objects C<type> and C<id> members to encode the object:
+
+ sub My::Object::FREEZE {
+ my ($self, $serializer) = @_;
+
+ ($self->{type}, $self->{id})
+ }
+
+=item 2. C<convert_blessed> is enabled and the object has a C<TO_JSON> method.
+
+In this case, the C<TO_JSON> method of the object is invoked in scalar
+context. It must return a single scalar that can be directly encoded into
+JSON. This scalar replaces the object in the JSON text.
+
+For example, the following C<TO_JSON> method will convert all L<URI>
+objects to JSON strings when serialized. The fact that these values
+originally were L<URI> objects is lost.
+
+ sub URI::TO_JSON {
+ my ($uri) = @_;
+ $uri->as_string
+ }
+
+=item 2. C<convert_blessed> is enabled and the object has a stringification overload.
+
+In this case, the overloaded C<""> method of the object is invoked in scalar
+context. It must return a single scalar that can be directly encoded into
+JSON. This scalar replaces the object in the JSON text.
+
+For example, the following C<""> method will convert all L<URI>
+objects to JSON strings when serialized. The fact that these values
+originally were L<URI> objects is lost.
+
+ package URI;
+ use overload '""' => sub { shift->as_string };
+
+=item 3. C<allow_blessed> is enabled.
+
+The object will be serialized as a JSON null value.
+
+=item 4. none of the above
+
+If none of the settings are enabled or the respective methods are missing,
+C<Cpanel::JSON::XS> throws an exception.
+
+=back
+
+=head3 DESERIALIZATION
+
+For deserialization there are only two cases to consider: either
+nonstandard tagging was used, in which case C<allow_tags> decides,
+or objects cannot be automatically be deserialized, in which
+case you can use postprocessing or the C<filter_json_object> or
+C<filter_json_single_key_object> callbacks to get some real objects our of
+your JSON.
+
+This section only considers the tagged value case: I a tagged JSON object
+is encountered during decoding and C<allow_tags> is disabled, a parse
+error will result (as if tagged values were not part of the grammar).
+
+If C<allow_tags> is enabled, C<Cpanel::JSON::XS> will look up the C<THAW> method
+of the package/classname used during serialization (it will not attempt
+to load the package as a Perl module). If there is no such method, the
+decoding will fail with an error.
+
+Otherwise, the C<THAW> method is invoked with the classname as first
+argument, the constant string C<JSON> as second argument, and all the
+values from the JSON array (the values originally returned by the
+C<FREEZE> method) as remaining arguments.
+
+The method must then return the object. While technically you can return
+any Perl scalar, you might have to enable the C<enable_nonref> setting to
+make that work in all cases, so better return an actual blessed reference.
+
+As an example, let's implement a C<THAW> function that regenerates the
+C<My::Object> from the C<FREEZE> example earlier:
+
+ sub My::Object::THAW {
+ my ($class, $serializer, $type, $id) = @_;
+
+ $class->new (type => $type, id => $id)
+ }
+
+See the L</SECURITY CONSIDERATIONS> section below. Allowing external
+json objects being deserialized to perl objects is usually a very bad
+idea.
+
+
+=head1 ENCODING/CODESET FLAG NOTES
+
+The interested reader might have seen a number of flags that signify
+encodings or codesets - C<utf8>, C<latin1>, C<binary> and
+C<ascii>. There seems to be some confusion on what these do, so here
+is a short comparison:
+
+C<utf8> controls whether the JSON text created by C<encode> (and expected
+by C<decode>) is UTF-8 encoded or not, while C<latin1> and C<ascii> only
+control whether C<encode> escapes character values outside their respective
+codeset range. Neither of these flags conflict with each other, although
+some combinations make less sense than others.
+
+Care has been taken to make all flags symmetrical with respect to
+C<encode> and C<decode>, that is, texts encoded with any combination of
+these flag values will be correctly decoded when the same flags are used
+- in general, if you use different flag settings while encoding vs. when
+decoding you likely have a bug somewhere.
+
+Below comes a verbose discussion of these flags. Note that a "codeset" is
+simply an abstract set of character-codepoint pairs, while an encoding
+takes those codepoint numbers and I<encodes> them, in our case into
+octets. Unicode is (among other things) a codeset, UTF-8 is an encoding,
+and ISO-8859-1 (= latin 1) and ASCII are both codesets I<and> encodings at
+the same time, which can be confusing.
+
+=over 4
+
+=item C<utf8> flag disabled
+
+When C<utf8> is disabled (the default), then C<encode>/C<decode> generate
+and expect Unicode strings, that is, characters with high ordinal Unicode
+values (> 255) will be encoded as such characters, and likewise such
+characters are decoded as-is, no changes to them will be done, except
+"(re-)interpreting" them as Unicode codepoints or Unicode characters,
+respectively (to Perl, these are the same thing in strings unless you do
+funny/weird/dumb stuff).
+
+This is useful when you want to do the encoding yourself (e.g. when you
+want to have UTF-16 encoded JSON texts) or when some other layer does
+the encoding for you (for example, when printing to a terminal using a
+filehandle that transparently encodes to UTF-8 you certainly do NOT want
+to UTF-8 encode your data first and have Perl encode it another time).
+
+=item C<utf8> flag enabled
+
+If the C<utf8>-flag is enabled, C<encode>/C<decode> will encode all
+characters using the corresponding UTF-8 multi-byte sequence, and will
+expect your input strings to be encoded as UTF-8, that is, no "character"
+of the input string must have any value > 255, as UTF-8 does not allow
+that.
+
+The C<utf8> flag therefore switches between two modes: disabled means you
+will get a Unicode string in Perl, enabled means you get an UTF-8 encoded
+octet/binary string in Perl.
+
+=item C<latin1>, C<binary> or C<ascii> flags enabled
+
+With C<latin1> (or C<ascii>) enabled, C<encode> will escape
+characters with ordinal values > 255 (> 127 with C<ascii>) and encode
+the remaining characters as specified by the C<utf8> flag.
+With C<binary> enabled, ordinal values > 255 are illegal.
+
+If C<utf8> is disabled, then the result is also correctly encoded in those
+character sets (as both are proper subsets of Unicode, meaning that a
+Unicode string with all character values < 256 is the same thing as a
+ISO-8859-1 string, and a Unicode string with all character values < 128 is
+the same thing as an ASCII string in Perl).
+
+If C<utf8> is enabled, you still get a correct UTF-8-encoded string,
+regardless of these flags, just some more characters will be escaped using
+C<\uXXXX> then before.
+
+Note that ISO-8859-1-I<encoded> strings are not compatible with UTF-8
+encoding, while ASCII-encoded strings are. That is because the ISO-8859-1
+encoding is NOT a subset of UTF-8 (despite the ISO-8859-1 I<codeset> being
+a subset of Unicode), while ASCII is.
+
+Surprisingly, C<decode> will ignore these flags and so treat all input
+values as governed by the C<utf8> flag. If it is disabled, this allows you
+to decode ISO-8859-1- and ASCII-encoded strings, as both strict subsets of
+Unicode. If it is enabled, you can correctly decode UTF-8 encoded strings.
+
+So neither C<latin1>, C<binary> nor C<ascii> are incompatible with the
+C<utf8> flag - they only govern when the JSON output engine escapes a
+character or not.
+
+The main use for C<latin1> or C<binary> is to relatively efficiently
+store binary data as JSON, at the expense of breaking compatibility
+with most JSON decoders.
+
+The main use for C<ascii> is to force the output to not contain characters
+with values > 127, which means you can interpret the resulting string
+as UTF-8, ISO-8859-1, ASCII, KOI8-R or most about any character set and
+8-bit-encoding, and still get the same data structure back. This is useful
+when your channel for JSON transfer is not 8-bit clean or the encoding
+might be mangled in between (e.g. in mail), and works because ASCII is a
+proper subset of most 8-bit and multibyte encodings in use in the world.
+
+=back
+
+
+=head2 JSON and ECMAscript
+
+JSON syntax is based on how literals are represented in javascript (the
+not-standardized predecessor of ECMAscript) which is presumably why it is
+called "JavaScript Object Notation".
+
+However, JSON is not a subset (and also not a superset of course) of
+ECMAscript (the standard) or javascript (whatever browsers actually
+implement).
+
+If you want to use javascript's C<eval> function to "parse" JSON, you
+might run into parse errors for valid JSON texts, or the resulting data
+structure might not be queryable:
+
+One of the problems is that U+2028 and U+2029 are valid characters inside
+JSON strings, but are not allowed in ECMAscript string literals, so the
+following Perl fragment will not output something that can be guaranteed
+to be parsable by javascript's C<eval>:
+
+ use Cpanel::JSON::XS;
+
+ print encode_json [chr 0x2028];
+
+The right fix for this is to use a proper JSON parser in your javascript
+programs, and not rely on C<eval> (see for example Douglas Crockford's
+F<json2.js> parser).
+
+If this is not an option, you can, as a stop-gap measure, simply encode to
+ASCII-only JSON:
+
+ use Cpanel::JSON::XS;
+
+ print Cpanel::JSON::XS->new->ascii->encode ([chr 0x2028]);
+
+Note that this will enlarge the resulting JSON text quite a bit if you
+have many non-ASCII characters. You might be tempted to run some regexes
+to only escape U+2028 and U+2029, e.g.:
+
+ # DO NOT USE THIS!
+ my $json = Cpanel::JSON::XS->new->utf8->encode ([chr 0x2028]);
+ $json =~ s/\xe2\x80\xa8/\\u2028/g; # escape U+2028
+ $json =~ s/\xe2\x80\xa9/\\u2029/g; # escape U+2029
+ print $json;
+
+Note that I<this is a bad idea>: the above only works for U+2028 and
+U+2029 and thus only for fully ECMAscript-compliant parsers. Many existing
+javascript implementations, however, have issues with other characters as
+well - using C<eval> naively simply I<will> cause problems.
+
+Another problem is that some javascript implementations reserve
+some property names for their own purposes (which probably makes
+them non-ECMAscript-compliant). For example, Iceweasel reserves the
+C<__proto__> property name for its own purposes.
+
+If that is a problem, you could parse try to filter the resulting JSON
+output for these property strings, e.g.:
+
+ $json =~ s/"__proto__"\s*:/"__proto__renamed":/g;
+
+This works because C<__proto__> is not valid outside of strings, so every
+occurrence of C<"__proto__"\s*:> must be a string used as property name.
+
+Unicode non-characters between U+FFFD and U+10FFFF are decoded either
+to the recommended U+FFFD REPLACEMENT CHARACTER (see Unicode PR #121:
+Recommended Practice for Replacement Characters), or in the binary or
+relaxed mode left as is, keeping the illegal non-characters as before.
+
+Raw non-Unicode characters outside the valid unicode range fail now to
+parse, because "A string is a sequence of zero or more Unicode
+characters" RFC 7159 section 1 and "JSON text SHALL be encoded in
+Unicode RFC 7159 section 8.1. We use now the UTF8_DISALLOW_SUPER
+flag when parsing unicode.
+
+If you know of other incompatibilities, please let me know.
+
+
+=head2 JSON and YAML
+
+You often hear that JSON is a subset of YAML. I<in general, there is
+no way to configure JSON::XS to output a data structure as valid YAML>
+that works in all cases. If you really must use Cpanel::JSON::XS to
+generate YAML, you should use this algorithm (subject to change in
+future versions):
+
+ my $to_yaml = Cpanel::JSON::XS->new->utf8->space_after (1);
+ my $yaml = $to_yaml->encode ($ref) . "\n";
+
+This will I<usually> generate JSON texts that also parse as valid
+YAML.
+
+
+=head2 SPEED
+
+It seems that JSON::XS is surprisingly fast, as shown in the following
+tables. They have been generated with the help of the C<eg/bench> program
+in the JSON::XS distribution, to make it easy to compare on your own
+system.
+
+JSON::XS is with L<Data::MessagePack> and L<Sereal> one of the fastest
+serializers, because JSON and JSON::XS do not support backrefs (no
+graph structures), only trees. Storable supports backrefs,
+i.e. graphs. Data::MessagePack encodes its data binary (as Storable)
+and supports only very simple subset of JSON.
+
+First comes a comparison between various modules using
+a very short single-line JSON string (also available at
+L<http://dist.schmorp.de/misc/json/short.json>).
+
+ {"method": "handleMessage", "params": ["user1",
+ "we were just talking"], "id": null, "array":[1,11,234,-5,1e5,1e7,
+ 1, 0]}
+
+It shows the number of encodes/decodes per second (JSON::XS uses
+the functional interface, while Cpanel::JSON::XS/2 uses the OO interface
+with pretty-printing and hash key sorting enabled, Cpanel::JSON::XS/3 enables
+shrink. JSON::DWIW/DS uses the deserialize function, while JSON::DWIW::FJ
+uses the from_json method). Higher is better:
+
+ module | encode | decode |
+ --------------|------------|------------|
+ JSON::DWIW/DS | 86302.551 | 102300.098 |
+ JSON::DWIW/FJ | 86302.551 | 75983.768 |
+ JSON::PP | 15827.562 | 6638.658 |
+ JSON::Syck | 63358.066 | 47662.545 |
+ JSON::XS | 511500.488 | 511500.488 |
+ JSON::XS/2 | 291271.111 | 388361.481 |
+ JSON::XS/3 | 361577.931 | 361577.931 |
+ Storable | 66788.280 | 265462.278 |
+ --------------+------------+------------+
+
+That is, JSON::XS is almost six times faster than JSON::DWIW on encoding,
+about five times faster on decoding, and over thirty to seventy times
+faster than JSON's pure perl implementation. It also compares favourably
+to Storable for small amounts of data.
+
+Using a longer test string (roughly 18KB, generated from Yahoo! Locals
+search API (L<http://dist.schmorp.de/misc/json/long.json>).
+
+ module | encode | decode |
+ --------------|------------|------------|
+ JSON::DWIW/DS | 1647.927 | 2673.916 |
+ JSON::DWIW/FJ | 1630.249 | 2596.128 |
+ JSON::PP | 400.640 | 62.311 |
+ JSON::Syck | 1481.040 | 1524.869 |
+ JSON::XS | 20661.596 | 9541.183 |
+ JSON::XS/2 | 10683.403 | 9416.938 |
+ JSON::XS/3 | 20661.596 | 9400.054 |
+ Storable | 19765.806 | 10000.725 |
+ --------------+------------+------------+
+
+Again, JSON::XS leads by far (except for Storable which non-surprisingly
+decodes a bit faster).
+
+On large strings containing lots of high Unicode characters, some modules
+(such as JSON::PC) seem to decode faster than JSON::XS, but the result
+will be broken due to missing (or wrong) Unicode handling. Others refuse
+to decode or encode properly, so it was impossible to prepare a fair
+comparison table for that case.
+
+For updated graphs see L<https://github.com/Sereal/Sereal/wiki/Sereal-Comparison-Graphs>
+
+
+=head1 INTEROP with JSON and JSON::XS and other JSON modules
+
+As long as you only serialize data that can be directly expressed in
+JSON, C<Cpanel::JSON::XS> is incapable of generating invalid JSON
+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.
+
+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
+other decoder is broken.
+
+When decoding, C<JSON::XS> is strict by default and will likely catch
+all errors. There are currently two settings that change this:
+C<relaxed> makes C<JSON::XS> accept (but not generate) some
+non-standard extensions, and C<allow_tags> or C<allow_blessed> will
+allow you to encode and decode Perl objects, at the cost of being
+totally insecure and not outputting valid JSON anymore.
+
+JSON-XS-3.01 broke interoperability with JSON-2.90 with booleans. See L<JSON>.
+
+Cpanel::JSON::XS needs to know the JSON and JSON::XS versions to be able work
+with those objects, especially when encoding a booleans like C<{"is_true":true}>.
+So you need to load these modules before.
+
+true/false overloading and boolean representations are supported.
+
+JSON::XS and JSON::PP representations are accepted and older JSON::XS
+accepts Cpanel::JSON::XS booleans. All JSON modules JSON, JSON, PP,
+JSON::XS, Cpanel::JSON::XS produce JSON::PP::Boolean objects, just
+Mojo and JSON::YAJL not. Mojo produces Mojo::JSON::_Bool and
+JSON::YAJL::Parser just an unblessed IV.
+
+Cpanel::JSON::XS accepts JSON::PP::Boolean and Mojo::JSON::_Bool
+objects as booleans.
+
+I cannot think of any reason to still use JSON::XS anymore.
+
+
+=head2 TAGGED VALUE SYNTAX AND STANDARD JSON EN/DECODERS
+
+When you use C<allow_tags> to use the extended (and also nonstandard
+and invalid) JSON syntax for serialized objects, and you still want to
+decode the generated serialize objects, you can run a regex to replace
+the tagged syntax by standard JSON arrays (it only works for "normal"
+package names without comma, newlines or single colons). First, the
+readable Perl version:
+
+ # if your FREEZE methods return no values, you need this replace first:
+ $json =~ s/\( \s* (" (?: [^\\":,]+|\\.|::)* ") \s* \) \s* \[\s*\]/[$1]/gx;
+
+ # this works for non-empty constructor arg lists:
+ $json =~ s/\( \s* (" (?: [^\\":,]+|\\.|::)* ") \s* \) \s* \[/[$1,/gx;
+
+And here is a less readable version that is easy to adapt to other
+languages:
+
+ $json =~ s/\(\s*("([^\\":,]+|\\.|::)*")\s*\)\s*\[/[$1,/g;
+
+Here is an ECMAScript version (same regex):
+
+ json = json.replace (/\(\s*("([^\\":,]+|\\.|::)*")\s*\)\s*\[/g, "[$1,");
+
+Since this syntax converts to standard JSON arrays, it might be hard to
+distinguish serialized objects from normal arrays. You can prepend a
+"magic number" as first array element to reduce chances of a collision:
+
+ $json =~ s/\(\s*("([^\\":,]+|\\.|::)*")\s*\)\s*\[/["XU1peReLzT4ggEllLanBYq4G9VzliwKF",$1,/g;
+
+And after decoding the JSON text, you could walk the data
+structure looking for arrays with a first element of
+C<XU1peReLzT4ggEllLanBYq4G9VzliwKF>.
+
+The same approach can be used to create the tagged format with another
+encoder. First, you create an array with the magic string as first member,
+the classname as second, and constructor arguments last, encode it as part
+of your JSON structure, and then:
+
+ $json =~ s/\[\s*"XU1peReLzT4ggEllLanBYq4G9VzliwKF"\s*,\s*("([^\\":,]+|\\.|::)*")\s*,/($1)[/g;
+
+Again, this has some limitations - the magic string must not be encoded
+with character escapes, and the constructor arguments must be non-empty.
+
+
+=head1 RFC7159
+
+Since this module was written, Google has written a new JSON RFC, RFC 7159
+(and RFC7158). Unfortunately, this RFC breaks compatibility with both the
+original JSON specification on www.json.org and RFC4627.
+
+As far as I can see, you can get partial compatibility when parsing by
+using C<< ->allow_nonref >>. However, consider the security implications
+of doing so.
+
+I haven't decided yet when to break compatibility with RFC4627 by default
+(and potentially leave applications insecure) and change the default to
+follow RFC7159, but application authors are well advised to call C<<
+->allow_nonref(0) >> even if this is the current default, if they cannot
+handle non-reference values, in preparation for the day when the default
+will change.
+
+=head1 SECURITY CONSIDERATIONS
+
+JSON::XS and Cpanel::JSON::XS are not only fast. JSON is generally the
+most secure serializing format, because it is the only one besides
+Data::MessagePack, which does not deserialize objects per default. For
+all languages, not just perl. The binary variant BSON (MongoDB) does
+more but is unsafe.
+
+It is trivial for any attacker to create such serialized objects in
+JSON and trick perl into expanding them, thereby triggering certain
+methods. Watch L<https://www.youtube.com/watch?v=Gzx6KlqiIZE> for an
+exploit demo for "CVE-2015-1592 SixApart MovableType Storable Perl
+Code Execution" for a deserializer which expands objects.
+Deserializing even coderefs (methods, functions) or external
+data would be considered the most dangerous.
+
+Security relevant overview of serializers regarding deserializing
+objects by default:
+
+ Objects Coderefs External Data
+
+ Data::Dumper YES YES YES
+ Storable YES NO (def) NO
+ Sereal YES NO NO
+ YAML YES NO NO
+ B::C YES YES YES
+ B::Bytecode YES YES YES
+ BSON YES YES NO
+ JSON::SL YES NO YES
+ JSON NO (def) NO NO
+ Data::MessagePack NO NO NO
+ XML NO NO YES
+
+ Pickle YES YES YES
+ PHP Deserialize YES NO NO
+
+When you are using JSON in a protocol, talking to untrusted potentially
+hostile creatures requires relatively few measures.
+
+First of all, your JSON decoder should be secure, that is, should not have
+any buffer overflows. Obviously, this module should ensure that.
+
+Second, you need to avoid resource-starving attacks. That means you should
+limit the size of JSON texts you accept, or make sure then when your
+resources run out, that's just fine (e.g. by using a separate process that
+can crash safely). The size of a JSON text in octets or characters is
+usually a good indication of the size of the resources required to decode
+it into a Perl structure. While JSON::XS can check the size of the JSON
+text, it might be too late when you already have it in memory, so you
+might want to check the size before you accept the string.
+
+Third, Cpanel::JSON::XS recurses using the C stack when decoding objects and
+arrays. The C stack is a limited resource: for instance, on my amd64
+machine with 8MB of stack size I can decode around 180k nested arrays but
+only 14k nested JSON objects (due to perl itself recursing deeply on croak
+to free the temporary). If that is exceeded, the program crashes. To be
+conservative, the default nesting limit is set to 512. If your process
+has a smaller stack, you should adjust this setting accordingly with the
+C<max_depth> method.
+
+Also keep in mind that Cpanel::JSON::XS might leak contents of your Perl data
+structures in its error messages, so when you serialize sensitive
+information you might want to make sure that exceptions thrown by JSON::XS
+will not end up in front of untrusted eyes.
+
+If you are using Cpanel::JSON::XS to return packets to consumption
+by JavaScript scripts in a browser you should have a look at
+L<http://blog.archive.jpsykes.com/47/practical-csrf-and-json-security/> to
+see whether you are vulnerable to some common attack vectors (which really
+are browser design bugs, but it is still you who will have to deal with
+it, as major browser developers care only for features, not about getting
+security right). You might also want to also look at L<Mojo::JSON>
+special escape rules to prevent from XSS attacks.
+
+=head1 "OLD" VS. "NEW" JSON (RFC 4627 VS. RFC 7159)
+
+TL;DR: Due to security concerns, Cpanel::JSON::XS will not allow
+scalar data in JSON texts by default - you need to create your own
+Cpanel::JSON::XS object and enable C<allow_nonref>:
+
+
+ my $json = JSON::XS->new->allow_nonref;
+
+ $text = $json->encode ($data);
+ $data = $json->decode ($text);
+
+The long version: JSON being an important and supposedly stable format,
+the IETF standardized it as RFC 4627 in 2006. Unfortunately the inventor
+of JSON Douglas Crockford unilaterally changed the definition of JSON in
+javascript. Rather than create a fork, the IETF decided to standardize the
+new syntax (apparently, so I as told, without finding it very amusing).
+
+The biggest difference between the original JSON and the new JSON is that
+the new JSON supports scalars (anything other than arrays and objects) at
+the top-level of a JSON text. While this is strictly backwards compatible
+to older versions, it breaks a number of protocols that relied on sending
+JSON back-to-back, and is a minor security concern.
+
+For example, imagine you have two banks communicating, and on one side,
+the JSON coder gets upgraded. Two messages, such as C<10> and C<1000>
+might then be confused to mean C<101000>, something that couldn't happen
+in the original JSON, because neither of these messages would be valid
+JSON.
+
+If one side accepts these messages, then an upgrade in the coder on either
+side could result in this becoming exploitable.
+
+This module has always allowed these messages as an optional extension, by
+default disabled. The security concerns are the reason why the default is
+still disabled, but future versions might/will likely upgrade to the newer
+RFC as default format, so you are advised to check your implementation
+and/or override the default with C<< ->allow_nonref (0) >> to ensure that
+future versions are safe.
+
+=head1 THREADS
+
+Cpanel::JSON::XS has proper ithreads support, unlike JSON::XS. If you
+encounter any bugs with thread support please report them.
+
+=head1 BUGS
+
+While the goal of the Cpanel::JSON::XS module is to be correct, that
+unfortunately does not mean it's bug-free, only that the author thinks
+its design is bug-free. If you keep reporting bugs and tests they will
+be fixed swiftly, though.
+
+Since the JSON::XS author refuses to use a public bugtracker and
+prefers private emails, we've setup a tracker at RT, so you might want
+to report any issues twice. Once in private to MLEHMANN to be fixed in
+JSON::XS and one to our the public tracker. Issues fixed by JSON::XS
+with a new release will also be backported to Cpanel::JSON::XS and
+5.6.2, as long as cPanel relies on 5.6.2 and Cpanel::JSON::XS as our
+serializer of choice.
+
+L<https://rt.cpan.org/Public/Dist/Display.html?Queue=Cpanel-JSON-XS>
+
+=head1 LICENSE
+
+This module is available under the same licences as perl, the Artistic
+license and the GPL.
+
+=cut
+
+sub allow_bigint {
+ Carp::carp("allow_bigint() is obsoleted. use allow_bignum() instead.");
+}
+
+BEGIN {
+ package
+ JSON::PP::Boolean;
+
+ 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 },
+ '""' => sub { ${$_[0]} == 1 ? '1' : '0' }, # GH 29
+ 'eq' => sub {
+ my ($obj, $op) = $_[2] ? ($_[1], $_[0]) : ($_[0], $_[1]);
+ #warn "eq obj:$obj op:$op len:", length($op) > 0, " swap:$_[2]";
+ if (ref $op) { # if 2nd also blessed might recurse endlessly
+ return $obj ? 1 == $op : 0 == $op;
+ }
+ # if string, only accept numbers or true|false or "" (e.g. !!0 / SV_NO)
+ elsif ($op !~ /^[0-9]+$/) {
+ return "$obj" eq '1' ? 'true' eq $op : 'false' eq $op || "" eq $op;
+ }
+ else {
+ return $obj ? 1 == $op : 0 == $op;
+ }
+ },
+ 'ne' => sub {
+ my ($obj, $op) = $_[2] ? ($_[1], $_[0]) : ($_[0], $_[1]);
+ #warn "ne obj:$obj op:$op";
+ return !($obj eq $op);
+ },
+ fallback => 1);
+}
+
+our ($true, $false);
+BEGIN {
+ if ($INC{'JSON/XS.pm'}
+ and $INC{'Types/Serialiser.pm'}
+ and $JSON::XS::VERSION ge "3.00") {
+ $true = $Types::Serialiser::true; # readonly if loaded by JSON::XS
+ $false = $Types::Serialiser::false;
+ } else {
+ $true = do { bless \(my $dummy = 1), "JSON::PP::Boolean" };
+ $false = do { bless \(my $dummy = 0), "JSON::PP::Boolean" };
+ }
+}
+
+BEGIN {
+ my $const_true = $true;
+ my $const_false = $false;
+ *true = sub () { $const_true };
+ *false = sub () { $const_false };
+}
+
+sub is_bool($) {
+ shift if @_ == 2; # as method call
+ (ref($_[0]) and UNIVERSAL::isa( $_[0], JSON::PP::Boolean::))
+ or (exists $INC{'Types/Serialiser.pm'} and Types::Serialiser::is_bool($_[0]))
+}
+
+XSLoader::load 'Cpanel::JSON::XS', $XS_VERSION;
+
+1;
+
+=head1 SEE ALSO
+
+The F<cpanel_json_xs> command line utility for quick experiments.
+
+L<JSON>, L<JSON::XS>, L<JSON::MaybeXS>, L<Mojo::JSON>, L<Mojo::JSON::MaybeXS>,
+L<JSON::SL>, L<JSON::DWIW>, L<JSON::YAJL>, L<JSON::Any>, L<Test::JSON>,
+L<Locale::Wolowitz>,
+L<https://metacpan.org/search?q=JSON>
+
+L<https://tools.ietf.org/html/rfc7159>
+
+L<https://tools.ietf.org/html/rfc4627>
+
+
+=head1 AUTHOR
+
+Reini Urban <rurban@cpan.org>
+
+Marc Lehmann <schmorp@schmorp.de>, http://home.schmorp.de/
+
+=head1 MAINTAINER
+
+Reini Urban <rurban@cpan.org>
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS/Boolean.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS/Boolean.pm
new file mode 100644
index 0000000000..5b2bf4f48a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS/Boolean.pm
@@ -0,0 +1,29 @@
+=head1 NAME
+
+Cpanel::JSON::XS::Boolean - true and false values
+
+=head1 SYNOPSIS
+
+ # do not "use" yourself
+
+See L<Cpanel::JSON::XS/"true, false">
+
+=head1 DESCRIPTION
+
+This module exists only to provide overload resolution for Storable
+and similar modules and interop with L<JSON::XS> booleans. See
+L<Cpanel::JSON::XS> for more info about this class.
+
+=cut
+
+use Cpanel::JSON::XS ();
+
+1;
+
+=head1 AUTHOR
+
+ Marc Lehmann <schmorp@schmorp.de>
+ http://home.schmorp.de/
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS/Type.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS/Type.pm
new file mode 100644
index 0000000000..9367f1b4fa
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Cpanel/JSON/XS/Type.pm
@@ -0,0 +1,311 @@
+package Cpanel::JSON::XS::Type;
+
+=pod
+
+=head1 NAME
+
+Cpanel::JSON::XS::Type - Type support for JSON encode
+
+=head1 SYNOPSIS
+
+ use Cpanel::JSON::XS;
+ use Cpanel::JSON::XS::Type;
+
+
+ encode_json([10, "10", 10.25], [JSON_TYPE_INT, JSON_TYPE_INT, JSON_TYPE_STRING]);
+ # '[10,10,"10.25"]'
+
+ encode_json([10, "10", 10.25], json_type_arrayof(JSON_TYPE_INT));
+ # '[10,10,10]'
+
+ encode_json(1, JSON_TYPE_BOOL);
+ # 'true'
+
+ my $perl_struct = { key1 => 1, key2 => "2", key3 => 1 };
+ my $type_spec = { key1 => JSON_TYPE_STRING, key2 => JSON_TYPE_INT, key3 => JSON_TYPE_BOOL };
+ my $json_string = encode_json($perl_struct, $type_spec);
+ # '{"key1":"1","key2":2,"key3":true}'
+
+ my $perl_struct = { key1 => "value1", key2 => "value2", key3 => 0, key4 => 1, key5 => "string", key6 => "string2" };
+ my $type_spec = json_type_hashof(JSON_TYPE_STRING);
+ my $json_string = encode_json($perl_struct, $type_spec);
+ # '{"key1":"value1","key2":"value2","key3":"0","key4":"1","key5":"string","key6":"string2"}'
+
+ my $perl_struct = { key1 => { key2 => [ 10, "10", 10.6 ] }, key3 => "10.5" };
+ my $type_spec = { key1 => json_type_anyof(JSON_TYPE_FLOAT, json_type_hashof(json_type_arrayof(JSON_TYPE_INT))), key3 => JSON_TYPE_FLOAT };
+ my $json_string = encode_json($perl_struct, $type_spec);
+ # '{"key1":{"key2":[10,10,10]},"key3":10.5}'
+
+
+ my $value = decode_json('false', 1, my $type);
+ # $value is 0 and $type is JSON_TYPE_BOOL
+
+ my $value = decode_json('0', 1, my $type);
+ # $value is 0 and $type is JSON_TYPE_INT
+
+ my $value = decode_json('"0"', 1, my $type);
+ # $value is 0 and $type is JSON_TYPE_STRING
+
+ my $json_string = '{"key1":{"key2":[10,"10",10.6]},"key3":"10.5"}';
+ my $perl_struct = decode_json($json_string, 0, my $type_spec);
+ # $perl_struct is { key1 => { key2 => [ 10, 10, 10.6 ] }, key3 => 10.5 }
+ # $type_spec is { key1 => { key2 => [ JSON_TYPE_INT, JSON_TYPE_STRING, JSON_TYPE_FLOAT ] }, key3 => JSON_TYPE_STRING }
+
+=head1 DESCRIPTION
+
+This module provides stable JSON type support for the
+L<Cpanel::JSON::XS|Cpanel::JSON::XS> encoder which doesn't depend on
+any internal perl scalar flags or characteristics. Also it provides
+real JSON types for L<Cpanel::JSON::XS|Cpanel::JSON::XS> decoder.
+
+In most cases perl structures passed to
+L<encode_json|Cpanel::JSON::XS/encode_json> come from other functions
+or from other modules and caller of Cpanel::JSON::XS module does not
+have control of internals or they are subject of change. So it is not
+easy to support enforcing types as described in the
+L<simple scalars|Cpanel::JSON::XS/simple scalars> section.
+
+For services based on JSON contents it is sometimes needed to correctly
+process and enforce JSON types.
+
+The function L<decode_json|Cpanel::JSON::XS/decode_json> takes optional
+third scalar parameter and fills it with specification of json types.
+
+The function L<encode_json|Cpanel::JSON::XS/encode_json> takes a perl
+structure as its input and optionally also a json type specification in
+the second parameter.
+
+If the specification is not provided (or is undef) internal perl
+scalar flags are used for the resulting JSON type. The internal flags
+can be changed by perl itself, but also by external modules. Which
+means that types in resulting JSON string aren't stable. Specially it
+does not work reliable for dual vars and scalars which were used in
+both numeric and string operations. See L<simple
+scalars|Cpanel::JSON::XS/simple scalars>.
+
+=head2 JSON type specification for scalars:
+
+=over 4
+
+=item JSON_TYPE_BOOL
+
+It enforces JSON boolean in resulting JSON, i.e. either C<true> or
+C<false>. For determining whether the scalar passed to the encoder
+is true, standard perl boolean logic is used.
+
+=item JSON_TYPE_INT
+
+It enforces JSON number without fraction part in the resulting JSON.
+Equivalent of perl function L<int|perlfunc/int> is used for conversion.
+
+=item JSON_TYPE_FLOAT
+
+It enforces JSON number with fraction part in the resulting JSON.
+Equivalent of perl operation C<+0> is used for conversion.
+
+=item JSON_TYPE_STRING
+
+It enforces JSON string type in the resulting JSON.
+
+=item JSON_TYPE_NULL
+
+It represents JSON C<null> value. Makes sense only when passing
+perl's C<undef> value.
+
+=back
+
+For each type, there also exists a type with the suffix C<_OR_NULL>
+which encodes perl's C<undef> into JSON C<null>. Without type with
+suffix C<_OR_NULL> perl's C<undef> is converted to specific type
+according to above rules.
+
+=head2 JSON type specification for arrays:
+
+=over 4
+
+=item [...]
+
+The array must contain the same number of elements as in the perl
+array passed for encoding. Each element of the array describes the
+JSON type which is enforced for the corresponding element of the
+perl array.
+
+=item json_type_arrayof
+
+This function takes a JSON type specification as its argument which
+is enforced for every element of the passed perl array.
+
+=back
+
+=head2 JSON type specification for hashes:
+
+=over 4
+
+=item {...}
+
+Each hash value for corresponding key describes the JSON type
+specification for values of passed perl hash structure. Keys in hash
+which are not present in passed perl hash structure are simple
+ignored and not used.
+
+=item json_type_hashof
+
+This function takes a JSON type specification as its argument which
+is enforced for every value of passed perl hash structure.
+
+=back
+
+=head2 JSON type specification for alternatives:
+
+=over 4
+
+=item json_type_anyof
+
+This function takes a list of JSON type alternative specifications
+(maximally one scalar, one array, and one hash) as its input and the
+JSON encoder chooses one that matches.
+
+=item json_type_null_or_anyof
+
+Like L<C<json_type_anyof>|/json_type_anyof>, but scalar can be only
+perl's C<undef>.
+
+=item json_type_weaken
+
+This function can be used as an argument for L</json_type_arrayof>,
+L</json_type_hashof> or L</json_type_anyof> functions to create weak
+references suitable for complicated recursive structures. It depends
+on L<the weaken function from Scalar::Util|Scalar::Util/weaken> module.
+See following example:
+
+ my $struct = {
+ type => JSON_TYPE_STRING,
+ array => json_type_arrayof(JSON_TYPE_INT),
+ };
+ $struct->{recursive} = json_type_anyof(
+ json_type_weaken($struct),
+ json_type_arrayof(JSON_TYPE_STRING),
+ );
+
+=back
+
+=head1 AUTHOR
+
+Pali E<lt>pali@cpan.orgE<gt>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright (c) 2017, GoodData Corporation. All rights reserved.
+
+This module is available under the same licences as perl, the Artistic
+license and the GPL.
+
+=cut
+
+use strict;
+use warnings;
+
+BEGIN {
+ if (eval { require Scalar::Util }) {
+ Scalar::Util->import('weaken');
+ } else {
+ *weaken = sub($) { die 'Scalar::Util is required for weaken' };
+ }
+}
+
+# This exports needed XS constants to perl
+use Cpanel::JSON::XS ();
+
+use Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT = our @EXPORT_OK = qw(
+ json_type_arrayof
+ json_type_hashof
+ json_type_anyof
+ json_type_null_or_anyof
+ json_type_weaken
+ JSON_TYPE_NULL
+ JSON_TYPE_BOOL
+ JSON_TYPE_INT
+ JSON_TYPE_FLOAT
+ JSON_TYPE_STRING
+ JSON_TYPE_BOOL_OR_NULL
+ JSON_TYPE_INT_OR_NULL
+ JSON_TYPE_FLOAT_OR_NULL
+ JSON_TYPE_STRING_OR_NULL
+ JSON_TYPE_ARRAYOF_CLASS
+ JSON_TYPE_HASHOF_CLASS
+ JSON_TYPE_ANYOF_CLASS
+);
+
+use constant JSON_TYPE_WEAKEN_CLASS => 'Cpanel::JSON::XS::Type::Weaken';
+
+sub json_type_anyof {
+ my ($scalar, $array, $hash);
+ my ($scalar_weaken, $array_weaken, $hash_weaken);
+ foreach (@_) {
+ my $type = $_;
+ my $ref = ref($_);
+ my $weaken;
+ if ($ref eq JSON_TYPE_WEAKEN_CLASS) {
+ $type = ${$type};
+ $ref = ref($type);
+ $weaken = 1;
+ }
+ if ($ref eq '') {
+ die 'Only one scalar type can be specified in anyof' if defined $scalar;
+ $scalar = $type;
+ $scalar_weaken = $weaken;
+ } elsif ($ref eq 'ARRAY' or $ref eq JSON_TYPE_ARRAYOF_CLASS) {
+ die 'Only one array type can be specified in anyof' if defined $array;
+ $array = $type;
+ $array_weaken = $weaken;
+ } elsif ($ref eq 'HASH' or $ref eq JSON_TYPE_HASHOF_CLASS) {
+ die 'Only one hash type can be specified in anyof' if defined $hash;
+ $hash = $type;
+ $hash_weaken = $weaken;
+ } else {
+ die 'Only scalar, array or hash can be specified in anyof';
+ }
+ }
+ my $type = [$scalar, $array, $hash];
+ weaken $type->[0] if $scalar_weaken;
+ weaken $type->[1] if $array_weaken;
+ weaken $type->[2] if $hash_weaken;
+ return bless $type, JSON_TYPE_ANYOF_CLASS;
+}
+
+sub json_type_null_or_anyof {
+ foreach (@_) {
+ die 'Scalar cannot be specified in null_or_anyof' if ref($_) eq '';
+ }
+ return json_type_anyof(JSON_TYPE_CAN_BE_NULL, @_);
+}
+
+sub json_type_arrayof {
+ die 'Exactly one type must be specified in arrayof' if scalar @_ != 1;
+ my $type = $_[0];
+ if (ref($type) eq JSON_TYPE_WEAKEN_CLASS) {
+ $type = ${$type};
+ weaken $type;
+ }
+ return bless \$type, JSON_TYPE_ARRAYOF_CLASS;
+}
+
+sub json_type_hashof {
+ die 'Exactly one type must be specified in hashof' if scalar @_ != 1;
+ my $type = $_[0];
+ if (ref($type) eq JSON_TYPE_WEAKEN_CLASS) {
+ $type = ${$type};
+ weaken $type;
+ }
+ return bless \$type, JSON_TYPE_HASHOF_CLASS;
+}
+
+sub json_type_weaken {
+ die 'Exactly one type must be specified in weaken' if scalar @_ != 1;
+ die 'Scalar cannot be specfied in weaken' if ref($_[0]) eq '';
+ return bless \(my $type = $_[0]), JSON_TYPE_WEAKEN_CLASS;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Format.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Format.pm
new file mode 100644
index 0000000000..3a1ea90ef1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Format.pm
@@ -0,0 +1,403 @@
+# Copyright (c) 1995-2009 Graham Barr. This program is free
+# software; you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+
+package Date::Format;
+
+use strict;
+use vars qw(@EXPORT @ISA $VERSION);
+require Exporter;
+
+$VERSION = "2.24";
+@ISA = qw(Exporter);
+@EXPORT = qw(time2str strftime ctime asctime);
+
+sub time2str ($;$$)
+{
+ Date::Format::Generic->time2str(@_);
+}
+
+sub strftime ($\@;$)
+{
+ Date::Format::Generic->strftime(@_);
+}
+
+sub ctime ($;$)
+{
+ my($t,$tz) = @_;
+ Date::Format::Generic->time2str("%a %b %e %T %Y\n", $t, $tz);
+}
+
+sub asctime (\@;$)
+{
+ my($t,$tz) = @_;
+ Date::Format::Generic->strftime("%a %b %e %T %Y\n", $t, $tz);
+}
+
+##
+##
+##
+
+package Date::Format::Generic;
+
+use vars qw($epoch $tzname);
+use Time::Zone;
+use Time::Local;
+
+sub ctime
+{
+ my($me,$t,$tz) = @_;
+ $me->time2str("%a %b %e %T %Y\n", $t, $tz);
+}
+
+sub asctime
+{
+ my($me,$t,$tz) = @_;
+ $me->strftime("%a %b %e %T %Y\n", $t, $tz);
+}
+
+sub _subs
+{
+ my $fn;
+ $_[1] =~ s/
+ %(O?[%a-zA-Z])
+ /
+ ($_[0]->can("format_$1") || sub { $1 })->($_[0]);
+ /sgeox;
+
+ $_[1];
+}
+
+sub strftime
+{
+ my($pkg,$fmt,$time);
+
+ ($pkg,$fmt,$time,$tzname) = @_;
+
+ my $me = ref($pkg) ? $pkg : bless [];
+
+ if(defined $tzname)
+ {
+ $tzname = uc $tzname;
+
+ $tzname = sprintf("%+05d",$tzname)
+ unless($tzname =~ /\D/);
+
+ $epoch = timegm(@{$time}[0..5]);
+
+ @$me = gmtime($epoch + tz_offset($tzname) - tz_offset());
+ }
+ else
+ {
+ @$me = @$time;
+ undef $epoch;
+ }
+
+ _subs($me,$fmt);
+}
+
+sub time2str
+{
+ my($pkg,$fmt,$time);
+
+ ($pkg,$fmt,$time,$tzname) = @_;
+
+ my $me = ref($pkg) ? $pkg : bless [], $pkg;
+
+ $epoch = $time;
+
+ if(defined $tzname)
+ {
+ $tzname = uc $tzname;
+
+ $tzname = sprintf("%+05d",$tzname)
+ unless($tzname =~ /\D/);
+
+ $time += tz_offset($tzname);
+ @$me = gmtime($time);
+ }
+ else
+ {
+ @$me = localtime($time);
+ }
+ $me->[9] = $time;
+ _subs($me,$fmt);
+}
+
+my(@DoW,@MoY,@DoWs,@MoYs,@AMPM,%format,@Dsuf);
+
+@DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
+
+@MoY = qw(January February March April May June
+ July August September October November December);
+
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+
+@AMPM = qw(AM PM);
+
+@Dsuf = (qw(th st nd rd th th th th th th)) x 3;
+@Dsuf[11,12,13] = qw(th th th);
+@Dsuf[30,31] = qw(th st);
+
+%format = ('x' => "%m/%d/%y",
+ 'C' => "%a %b %e %T %Z %Y",
+ 'X' => "%H:%M:%S",
+ );
+
+my @locale;
+my $locale = "/usr/share/lib/locale/LC_TIME/default";
+local *LOCALE;
+
+if(open(LOCALE,"$locale"))
+ {
+ chop(@locale = <LOCALE>);
+ close(LOCALE);
+
+ @MoYs = @locale[0 .. 11];
+ @MoY = @locale[12 .. 23];
+ @DoWs = @locale[24 .. 30];
+ @DoW = @locale[31 .. 37];
+ @format{"X","x","C"} = @locale[38 .. 40];
+ @AMPM = @locale[41 .. 42];
+ }
+
+sub wkyr {
+ my($wstart, $wday, $yday) = @_;
+ $wday = ($wday + 7 - $wstart) % 7;
+ return int(($yday - $wday + 13) / 7 - 1);
+}
+
+##
+## these 6 formatting routins need to be *copied* into the language
+## specific packages
+##
+
+my @roman = ('',qw(I II III IV V VI VII VIII IX));
+sub roman {
+ my $n = shift;
+
+ $n =~ s/(\d)$//;
+ my $r = $roman[ $1 ];
+
+ if($n =~ s/(\d)$//) {
+ (my $t = $roman[$1]) =~ tr/IVX/XLC/;
+ $r = $t . $r;
+ }
+ if($n =~ s/(\d)$//) {
+ (my $t = $roman[$1]) =~ tr/IVX/CDM/;
+ $r = $t . $r;
+ }
+ if($n =~ s/(\d)$//) {
+ (my $t = $roman[$1]) =~ tr/IVX/M../;
+ $r = $t . $r;
+ }
+ $r;
+}
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_P { lc($_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0]) }
+
+sub format_d { sprintf("%02d",$_[0]->[3]) }
+sub format_e { sprintf("%2d",$_[0]->[3]) }
+sub format_H { sprintf("%02d",$_[0]->[2]) }
+sub format_I { sprintf("%02d",$_[0]->[2] % 12 || 12)}
+sub format_j { sprintf("%03d",$_[0]->[7] + 1) }
+sub format_k { sprintf("%2d",$_[0]->[2]) }
+sub format_l { sprintf("%2d",$_[0]->[2] % 12 || 12)}
+sub format_L { $_[0]->[4] + 1 }
+sub format_m { sprintf("%02d",$_[0]->[4] + 1) }
+sub format_M { sprintf("%02d",$_[0]->[1]) }
+sub format_q { sprintf("%01d",int($_[0]->[4] / 3) + 1) }
+sub format_s {
+ $epoch = timelocal(@{$_[0]}[0..5])
+ unless defined $epoch;
+ sprintf("%d",$epoch)
+}
+sub format_S { sprintf("%02d",$_[0]->[0]) }
+sub format_U { wkyr(0, $_[0]->[6], $_[0]->[7]) }
+sub format_w { $_[0]->[6] }
+sub format_W { wkyr(1, $_[0]->[6], $_[0]->[7]) }
+sub format_y { sprintf("%02d",$_[0]->[5] % 100) }
+sub format_Y { sprintf("%04d",$_[0]->[5] + 1900) }
+
+sub format_Z {
+ my $o = tz_local_offset(timelocal(@{$_[0]}[0..5]));
+ defined $tzname ? $tzname : uc tz_name($o, $_[0]->[8]);
+}
+
+sub format_z {
+ my $t = timelocal(@{$_[0]}[0..5]);
+ my $o = defined $tzname ? tz_offset($tzname, $t) : tz_offset(undef,$t);
+ sprintf("%+03d%02d", int($o / 3600), int(abs($o) % 3600) / 60);
+}
+
+sub format_c { &format_x . " " . &format_X }
+sub format_D { &format_m . "/" . &format_d . "/" . &format_y }
+sub format_r { &format_I . ":" . &format_M . ":" . &format_S . " " . &format_p }
+sub format_R { &format_H . ":" . &format_M }
+sub format_T { &format_H . ":" . &format_M . ":" . &format_S }
+sub format_t { "\t" }
+sub format_n { "\n" }
+sub format_o { sprintf("%2d%s",$_[0]->[3],$Dsuf[$_[0]->[3]]) }
+sub format_x { my $f = $format{'x'}; _subs($_[0],$f); }
+sub format_X { my $f = $format{'X'}; _subs($_[0],$f); }
+sub format_C { my $f = $format{'C'}; _subs($_[0],$f); }
+
+sub format_Od { roman(format_d(@_)) }
+sub format_Oe { roman(format_e(@_)) }
+sub format_OH { roman(format_H(@_)) }
+sub format_OI { roman(format_I(@_)) }
+sub format_Oj { roman(format_j(@_)) }
+sub format_Ok { roman(format_k(@_)) }
+sub format_Ol { roman(format_l(@_)) }
+sub format_Om { roman(format_m(@_)) }
+sub format_OM { roman(format_M(@_)) }
+sub format_Oq { roman(format_q(@_)) }
+sub format_Oy { roman(format_y(@_)) }
+sub format_OY { roman(format_Y(@_)) }
+
+sub format_G { int(($_[0]->[9] - 315993600) / 604800) }
+
+1;
+__END__
+
+=head1 NAME
+
+Date::Format - Date formating subroutines
+
+=head1 SYNOPSIS
+
+ use Date::Format;
+
+ @lt = localtime(time);
+
+ print time2str($template, time);
+ print strftime($template, @lt);
+
+ print time2str($template, time, $zone);
+ print strftime($template, @lt, $zone);
+
+ print ctime(time);
+ print asctime(@lt);
+
+ print ctime(time, $zone);
+ print asctime(@lt, $zone);
+
+=head1 DESCRIPTION
+
+This module provides routines to format dates into ASCII strings. They
+correspond to the C library routines C<strftime> and C<ctime>.
+
+=over 4
+
+=item time2str(TEMPLATE, TIME [, ZONE])
+
+C<time2str> converts C<TIME> into an ASCII string using the conversion
+specification given in C<TEMPLATE>. C<ZONE> if given specifies the zone
+which the output is required to be in, C<ZONE> defaults to your current zone.
+
+
+=item strftime(TEMPLATE, TIME [, ZONE])
+
+C<strftime> is similar to C<time2str> with the exception that the time is
+passed as an array, such as the array returned by C<localtime>.
+
+=item ctime(TIME [, ZONE])
+
+C<ctime> calls C<time2str> with the given arguments using the
+conversion specification C<"%a %b %e %T %Y\n">
+
+=item asctime(TIME [, ZONE])
+
+C<asctime> calls C<time2str> with the given arguments using the
+conversion specification C<"%a %b %e %T %Y\n">
+
+=back
+
+=head1 MULTI-LANGUAGE SUPPORT
+
+Date::Format is capable of formating into several languages by creating
+a language specific object and calling methods, see L<Date::Language>
+
+ my $lang = Date::Language->new('German');
+ $lang->time2str("%a %b %e %T %Y\n", time);
+
+I am open to suggestions on this.
+
+=head1 CONVERSION SPECIFICATION
+
+Each conversion specification is replaced by appropriate
+characters as described in the following list. The
+appropriate characters are determined by the LC_TIME
+category of the program's locale.
+
+ %% PERCENT
+ %a day of the week abbr
+ %A day of the week
+ %b month abbr
+ %B month
+ %c MM/DD/YY HH:MM:SS
+ %C ctime format: Sat Nov 19 21:05:57 1994
+ %d numeric day of the month, with leading zeros (eg 01..31)
+ %e like %d, but a leading zero is replaced by a space (eg 1..32)
+ %D MM/DD/YY
+ %G GPS week number (weeks since January 6, 1980)
+ %h month abbr
+ %H hour, 24 hour clock, leading 0's)
+ %I hour, 12 hour clock, leading 0's)
+ %j day of the year
+ %k hour
+ %l hour, 12 hour clock
+ %L month number, starting with 1
+ %m month number, starting with 01
+ %M minute, leading 0's
+ %n NEWLINE
+ %o ornate day of month -- "1st", "2nd", "25th", etc.
+ %p AM or PM
+ %P am or pm (Yes %p and %P are backwards :)
+ %q Quarter number, starting with 1
+ %r time format: 09:05:57 PM
+ %R time format: 21:05
+ %s seconds since the Epoch, UCT
+ %S seconds, leading 0's
+ %t TAB
+ %T time format: 21:05:57
+ %U week number, Sunday as first day of week
+ %w day of the week, numerically, Sunday == 0
+ %W week number, Monday as first day of week
+ %x date format: 11/19/94
+ %X time format: 21:05:57
+ %y year (2 digits)
+ %Y year (4 digits)
+ %Z timezone in ascii. eg: PST
+ %z timezone in format -/+0000
+
+C<%d>, C<%e>, C<%H>, C<%I>, C<%j>, C<%k>, C<%l>, C<%m>, C<%M>, C<%q>,
+C<%y> and C<%Y> can be output in Roman numerals by prefixing the letter
+with C<O>, e.g. C<%OY> will output the year as roman numerals.
+
+=head1 LIMITATION
+
+The functions in this module are limited to the time range that can be
+represented by the time_t data type, i.e. 1901-12-13 20:45:53 GMT to
+2038-01-19 03:14:07 GMT.
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-2009 Graham Barr. This program 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/Date/Language.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language.pm
new file mode 100644
index 0000000000..02a05e7186
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language.pm
@@ -0,0 +1,144 @@
+
+package Date::Language;
+
+use strict;
+use Time::Local;
+use Carp;
+use vars qw($VERSION @ISA);
+require Date::Format;
+
+$VERSION = "1.10";
+@ISA = qw(Date::Format::Generic);
+
+sub new
+{
+ my $self = shift;
+ my $type = shift || $self;
+
+ $type =~ s/^(\w+)$/Date::Language::$1/;
+
+ croak "Bad language"
+ unless $type =~ /^[\w:]+$/;
+
+ eval "require $type"
+ or croak $@;
+
+ bless [], $type;
+}
+
+# Stop AUTOLOAD being called ;-)
+sub DESTROY {}
+
+sub AUTOLOAD
+{
+ use vars qw($AUTOLOAD);
+
+ if($AUTOLOAD =~ /::strptime\Z/o)
+ {
+ my $self = $_[0];
+ my $type = ref($self) || $self;
+ require Date::Parse;
+
+ no strict 'refs';
+ *{"${type}::strptime"} = Date::Parse::gen_parser(
+ \%{"${type}::DoW"},
+ \%{"${type}::MoY"},
+ \@{"${type}::Dsuf"},
+ 1);
+
+ goto &{"${type}::strptime"};
+ }
+
+ croak "Undefined method &$AUTOLOAD called";
+}
+
+sub str2time
+{
+ my $me = shift;
+ my @t = $me->strptime(@_);
+
+ return undef
+ unless @t;
+
+ my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
+ my @lt = localtime(time);
+
+ $hh ||= 0;
+ $mm ||= 0;
+ $ss ||= 0;
+
+ $month = $lt[4]
+ unless(defined $month);
+
+ $day = $lt[3]
+ unless(defined $day);
+
+ $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
+ unless(defined $year);
+
+ return defined $zone ? timegm($ss,$mm,$hh,$day,$month,$year) - $zone
+ : timelocal($ss,$mm,$hh,$day,$month,$year);
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Date::Language - Language specific date formating and parsing
+
+=head1 SYNOPSIS
+
+ use Date::Language;
+
+ my $lang = Date::Language->new('German');
+ $lang->time2str("%a %b %e %T %Y\n", time);
+
+=head1 DESCRIPTION
+
+L<Date::Language> provides objects to parse and format dates for specific languages. Available languages are
+
+ Afar French Russian_cp1251
+ Amharic Gedeo Russian_koi8r
+ Austrian German Sidama
+ Brazilian Greek Somali
+ Chinese Hungarian Spanish
+ Chinese_GB Icelandic Swedish
+ Czech Italian Tigrinya
+ Danish Norwegian TigrinyaEritrean
+ Dutch Oromo TigrinyaEthiopian
+ English Romanian Turkish
+ Finnish Russian Bulgarian
+
+=head1 METHODS
+
+=over
+
+=item time2str
+
+See L<Date::Format/time2str>
+
+=item strftime
+
+See L<Date::Format/strftime>
+
+=item ctime
+
+See L<Date::Format/ctime>
+
+=item asctime
+
+See L<Date::Format/asctime>
+
+=item str2time
+
+See L<Date::Parse/str2time>
+
+=item strptime
+
+See L<Date::Parse/strptime>
+
+=back
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Afar.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Afar.pm
new file mode 100644
index 0000000000..f67cf37685
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Afar.pm
@@ -0,0 +1,49 @@
+##
+## Afar tables
+##
+
+package Date::Language::Afar;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "0.99";
+
+@DoW = qw(Acaada Etleeni Talaata Arbaqa Kamiisi Gumqata Sabti);
+@MoY = (
+"Qunxa Garablu",
+"Kudo",
+"Ciggilta Kudo",
+"Agda Baxis",
+"Caxah Alsa",
+"Qasa Dirri",
+"Qado Dirri",
+"Liiqen",
+"Waysu",
+"Diteli",
+"Ximoli",
+"Kaxxa Garablu"
+);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(saaku carra);
+
+@Dsuf = (qw(th st nd rd th th th th th th)) x 3;
+@Dsuf[11,12,13] = qw(th th th);
+@Dsuf[30,31] = qw(th st);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Amharic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Amharic.pm
new file mode 100644
index 0000000000..a79984ecff
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Amharic.pm
@@ -0,0 +1,87 @@
+##
+## Amharic tables
+##
+
+package Date::Language::Amharic;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.00";
+
+if ( $] >= 5.006 ) {
+@DoW = (
+"\x{12a5}\x{1211}\x{12f5}",
+"\x{1230}\x{129e}",
+"\x{121b}\x{12ad}\x{1230}\x{129e}",
+"\x{1228}\x{1261}\x{12d5}",
+"\x{1210}\x{1219}\x{1235}",
+"\x{12d3}\x{122d}\x{1265}",
+"\x{1245}\x{12f3}\x{121c}"
+);
+@MoY = (
+"\x{1303}\x{1295}\x{12e9}\x{12c8}\x{122a}",
+"\x{134c}\x{1265}\x{1229}\x{12c8}\x{122a}",
+"\x{121b}\x{122d}\x{127d}",
+"\x{12a4}\x{1355}\x{1228}\x{120d}",
+"\x{121c}\x{12ed}",
+"\x{1301}\x{1295}",
+"\x{1301}\x{120b}\x{12ed}",
+"\x{12a6}\x{1308}\x{1235}\x{1275}",
+"\x{1234}\x{1355}\x{1274}\x{121d}\x{1260}\x{122d}",
+"\x{12a6}\x{12ad}\x{1270}\x{12cd}\x{1260}\x{122d}",
+"\x{1296}\x{126c}\x{121d}\x{1260}\x{122d}",
+"\x{12f2}\x{1234}\x{121d}\x{1260}\x{122d}"
+);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = ( "\x{1320}\x{12cb}\x{1275}", "\x{12a8}\x{1230}\x{12d3}\x{1275}" );
+
+@Dsuf = ("\x{129b}" x 31);
+}
+else {
+@DoW = (
+"እሑድ",
+"ሰኞ",
+"ማክሰኞ",
+"ረቡዕ",
+"áˆáˆ™áˆµ",
+"ዓርብ",
+"ቅዳሜ"
+);
+@MoY = (
+"ጃንዩወሪ",
+"áŒá‰¥áˆ©á‹ˆáˆª",
+"ማርች",
+"ኤá•áˆ¨áˆ",
+"ሜይ",
+"áŒáŠ•",
+"áŒáˆ‹á‹­",
+"ኦገስት",
+"ሴá•á‰´áˆá‰ áˆ­",
+"ኦክተá‹á‰ áˆ­",
+"ኖቬáˆá‰ áˆ­",
+"ዲሴáˆá‰ áˆ­"
+);
+@DoWs = map { substr($_,0,9) } @DoW;
+@MoYs = map { substr($_,0,9) } @MoY;
+@AMPM = ( "ጠዋት", "ከሰዓት" );
+
+@Dsuf = ("ኛ" x 31);
+}
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Austrian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Austrian.pm
new file mode 100644
index 0000000000..8ff398bd10
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Austrian.pm
@@ -0,0 +1,36 @@
+##
+## Austrian tables
+##
+
+package Date::Language::Austrian;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@MoY = qw(Jänner Feber März April Mai Juni
+ Juli August September Oktober November Dezember);
+@MoYs = qw(Jän Feb Mär Apr Mai Jun Jul Aug Sep Oct Nov Dez);
+@DoW = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag);
+@DoWs = qw(Son Mon Die Mit Don Fre Sam);
+
+use Date::Language::English ();
+@AMPM = @{Date::Language::English::AMPM};
+@Dsuf = @{Date::Language::English::Dsuf};
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Brazilian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Brazilian.pm
new file mode 100644
index 0000000000..fa4d15fff9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Brazilian.pm
@@ -0,0 +1,35 @@
+##
+## Brazilian tables, contributed by Christian Tosta (tosta@cce.ufmg.br)
+##
+
+package Date::Language::Brazilian;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@DoW = qw(Domingo Segunda Terça Quarta Quinta Sexta Sábado);
+@MoY = qw(Janeiro Fevereiro Março Abril Maio Junho
+ Julho Agosto Setembro Outubro Novembro Dezembro);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(AM PM);
+
+@Dsuf = (qw(mo ro do ro to to to mo vo no)) x 3;
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Bulgarian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Bulgarian.pm
new file mode 100644
index 0000000000..cf3d127486
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Bulgarian.pm
@@ -0,0 +1,92 @@
+##
+## Bulgarian tables contributed by Krasimir Berov
+##
+
+package Date::Language::Bulgarian;
+use strict;
+use warnings;
+use utf8;
+use base qw(Date::Language);
+our (@DoW, @DoWs, @MoY, @MoYs, @AMPM, @Dsuf, %MoY, %DoW, $VERSION);
+$VERSION = "1.01";
+
+@DoW = qw(Ð½ÐµÐ´ÐµÐ»Ñ Ð¿Ð¾Ð½ÐµÐ´ÐµÐ»Ð½Ð¸Ðº вторник ÑÑ€Ñда четвъртък петък Ñъбота);
+@MoY = qw(Ñнуари февруари март април май юни
+ юли авгуÑÑ‚ Ñептември октомври ноември декември);
+@DoWs = qw(нд пн вт ÑÑ€ чт пт Ñб);
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(AM PM);
+
+@Dsuf = (qw(ти ви ри ти ти ти ти ми ми ти)) x 3;
+@Dsuf[11,12,13] = qw(ти ти ти);
+@Dsuf[30,31] = qw(ти ви);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_o { ($_[0]->[3]<10?' ':'').$_[0]->[3].$Dsuf[$_[0]->[3]] }
+
+1;
+
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+Date::Language::Bulgarian - localization for Date::Format
+
+=head1 DESCRIPTION
+
+This is Bulgarian localization for Date::Format.
+It is important to note that this module source code is in utf8.
+All strings which it outputs are in utf8, so it is safe to use it
+currently only with English. You are left alone to try and convert
+the output when using different Date::Language::* in the same application.
+This should be addresed in the future.
+
+=head1 SYNOPSIS
+
+ use strict;
+ use warnings;
+ use Date::Language;
+ local $\=$/;
+ my $template ='%a %b %e %T %Y (%Y-%m-%d %H:%M:%S)';
+ my $time=1290883821; #or just use time();
+ my @lt = localtime($time);
+ my %languages = qw(English GMT German EEST Bulgarian EET);
+ binmode(select,':utf8');
+
+ foreach my $l(keys %languages){
+ my $lang = Date::Language->new($l);
+ my $zone = $languages{$l};
+ print $/. "$l $zone";
+ print $lang->time2str($template, $time);
+ print $lang->time2str($template, $time, $zone);
+
+ print $lang->strftime($template, \@lt);
+ }
+
+=head1 AUTHOR
+
+Krasimir Berov (berov@cpan.org)
+
+=head1 COPYRIGHT
+
+Copyright (c) 2010 Krasimir Berov. This program 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/Date/Language/Chinese.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Chinese.pm
new file mode 100644
index 0000000000..abfb3c0572
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Chinese.pm
@@ -0,0 +1,36 @@
+##
+## English tables
+##
+
+package Date::Language::Chinese;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.00";
+
+@DoW = qw(星期日 星期一 星期二 星期三 星期四 星期五 星期六);
+@MoY = qw(一月 二月 三月 四月 五月 六月
+ 七月 八月 ä¹æœˆ å月 å一月 å二月);
+@DoWs = map { $_ } @DoW;
+@MoYs = map { $_ } @MoY;
+@AMPM = qw(ä¸Šåˆ ä¸‹åˆ);
+
+@Dsuf = (qw(æ—¥ æ—¥ æ—¥ æ—¥ æ—¥ æ—¥ æ—¥ æ—¥ æ—¥ æ—¥)) x 3;
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+sub format_o { sprintf("%2d%s",$_[0]->[3],"æ—¥") }
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Chinese_GB.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Chinese_GB.pm
new file mode 100644
index 0000000000..7be0555226
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Chinese_GB.pm
@@ -0,0 +1,36 @@
+##
+## English tables
+##
+
+package Date::Language::Chinese_GB;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@DoW = qw(ÐÇÆÚÈÕ ÐÇÆÚÒ» ÐÇÆÚ¶þ ÐÇÆÚÈý ÐÇÆÚËÄ ÐÇÆÚÎå ÐÇÆÚÁù);
+@MoY = qw(Ò»ÔÂ ¶þÔÂ ÈýÔÂ ËÄÔÂ ÎåÔÂ ÁùÔÂ
+ ÆßÔ °ËÔ ¾ÅÔ ʮÔ ʮһÔ ʮ¶þÔÂ);
+@DoWs = map { $_ } @DoW;
+@MoYs = map { $_ } @MoY;
+@AMPM = qw(ÉÏÎç ÏÂÎç);
+
+@Dsuf = (qw(ÈÕ ÈÕ ÈÕ ÈÕ ÈÕ ÈÕ ÈÕ ÈÕ ÈÕ ÈÕ)) x 3;
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+sub format_o { sprintf("%2d%s",$_[0]->[3],"ÈÕ") }
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Czech.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Czech.pm
new file mode 100644
index 0000000000..756f5c552f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Czech.pm
@@ -0,0 +1,58 @@
+##
+## Czech tables
+##
+## Contributed by Honza Pazdziora
+
+package Date::Language::Czech;
+
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @MoY2 @AMPM %MoY %DoW $VERSION);
+@ISA = qw(Date::Language Date::Format::Generic);
+$VERSION = "1.01";
+
+@MoY = qw(leden únor bøezen duben kvìten èerven èervenec srpen záøí
+ øíjen listopad prosinec);
+@MoYs = qw(led únor bøe dub kvì èvn èec srp záøí øíj lis pro);
+@MoY2 = @MoY;
+for (@MoY2)
+ { s!en$!na! or s!ec$!ce! or s!ad$!adu! or s!or$!ora!; }
+
+@DoW = qw(nedìle pondìlí úterý støeda ètvrtek pátek sobota);
+@DoWs = qw(Ne Po Út St Èt Pá So);
+
+@AMPM = qw(dop. odp.);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+sub format_d { $_[0]->[3] }
+sub format_m { $_[0]->[4] + 1 }
+sub format_o { $_[0]->[3] . '.' }
+
+sub format_Q { $MoY2[$_[0]->[4]] }
+
+sub time2str {
+ my $ref = shift;
+ my @a = @_;
+ $a[0] =~ s/(%[do]\.?\s?)%B/$1%Q/;
+ $ref->SUPER::time2str(@a);
+ }
+
+sub strftime {
+ my $ref = shift;
+ my @a = @_;
+ $a[0] =~ s/(%[do]\.?\s?)%B/$1%Q/;
+ $ref->SUPER::time2str(@a);
+ }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Danish.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Danish.pm
new file mode 100644
index 0000000000..c43d08528e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Danish.pm
@@ -0,0 +1,36 @@
+##
+## Danish tables
+##
+
+package Date::Language::Danish;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@MoY = qw(Januar Februar Marts April Maj Juni
+ Juli August September Oktober November December);
+@MoYs = qw(Jan Feb Mar Apr Maj Jun Jul Aug Sep Okt Nov Dec);
+@DoW = qw(Søndag Mandag Tirsdag Onsdag Torsdag Fredag Lørdag Søndag);
+@DoWs = qw(Søn Man Tir Ons Tor Fre Lør Søn);
+
+use Date::Language::English ();
+@AMPM = @{Date::Language::English::AMPM};
+@Dsuf = @{Date::Language::English::Dsuf};
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Dutch.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Dutch.pm
new file mode 100644
index 0000000000..219758b4b2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Dutch.pm
@@ -0,0 +1,40 @@
+##
+## Dutch tables
+## Contributed by Johannes la Poutre <jlpoutre@corp.nl.home.com>
+##
+
+package Date::Language::Dutch;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.02";
+
+@MoY = qw(januari februari maart april mei juni juli
+ augustus september oktober november december);
+@MoYs = map(substr($_, 0, 3), @MoY);
+$MoYs[2] = 'mrt'; # mrt is more common (Frank Maas)
+@DoW = map($_ . "dag", qw(zon maan dins woens donder vrij zater));
+@DoWs = map(substr($_, 0, 2), @DoW);
+
+# these aren't normally used...
+@AMPM = qw(VM NM);
+@Dsuf = ('e') x 31;
+
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_o { sprintf("%2de",$_[0]->[3]) }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/English.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/English.pm
new file mode 100644
index 0000000000..638cb3c2a2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/English.pm
@@ -0,0 +1,37 @@
+##
+## English tables
+##
+
+package Date::Language::English;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@DoW = qw(Sunday Monday Tuesday Wednesday Thursday Friday Saturday);
+@MoY = qw(January February March April May June
+ July August September October November December);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(AM PM);
+
+@Dsuf = (qw(th st nd rd th th th th th th)) x 3;
+@Dsuf[11,12,13] = qw(th th th);
+@Dsuf[30,31] = qw(th st);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Finnish.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Finnish.pm
new file mode 100644
index 0000000000..415b50c73d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Finnish.pm
@@ -0,0 +1,45 @@
+##
+## Finnish tables
+## Contributed by Matthew Musgrove <muskrat@mindless.com>
+## Corrected by roke
+##
+
+package Date::Language::Finnish;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+# In Finnish, the names of the months and days are only capitalized at the beginning of sentences.
+@MoY = map($_ . "kuu", qw(tammi helmi maalis huhti touko kesä heinä elo syys loka marras joulu));
+@DoW = qw(sunnuntai maanantai tiistai keskiviikko torstai perjantai lauantai);
+
+# it is not customary to use abbreviated names of months or days
+# per Graham's suggestion:
+@MoYs = @MoY;
+@DoWs = @DoW;
+
+# the short form of ordinals
+@Dsuf = ('.') x 31;
+
+# doesn't look like this is normally used...
+@AMPM = qw(ap ip);
+
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_o { sprintf("%2de",$_[0]->[3]) }
+
+1; \ No newline at end of file
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/French.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/French.pm
new file mode 100644
index 0000000000..91b414c2eb
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/French.pm
@@ -0,0 +1,36 @@
+##
+## French tables, contributed by Emmanuel Bataille (bem@residents.frmug.org)
+##
+
+package Date::Language::French;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.04";
+
+@DoW = qw(dimanche lundi mardi mercredi jeudi vendredi samedi);
+@MoY = qw(janvier février mars avril mai juin
+ juillet août septembre octobre novembre décembre);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+$MoYs[6] = 'jul';
+@AMPM = qw(AM PM);
+
+@Dsuf = ((qw(er e e e e e e e e e)) x 3, 'er');
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Gedeo.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Gedeo.pm
new file mode 100644
index 0000000000..c18ad8cadd
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Gedeo.pm
@@ -0,0 +1,51 @@
+##
+## Gedeo tables
+##
+
+package Date::Language::Gedeo;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "0.99";
+
+@DoW = qw( Sanbbattaa Sanno Masano Roobe Hamusse Arbe Qiddamme);
+@MoY = (
+"Oritto",
+"Birre'a",
+"Onkkollessa",
+"Saddasa",
+"Arrasa",
+"Qammo",
+"Ella",
+"Waacibajje",
+"Canissa",
+"Addolessa",
+"Bittitotessa",
+"Hegeya"
+);
+@DoWs = map { substr($_,0,3) } @DoW;
+$DoWs[0] = "Snb";
+$DoWs[1] = "Sno";
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(gorsa warreti-udumma);
+
+@Dsuf = (qw(th st nd rd th th th th th th)) x 3;
+@Dsuf[11,12,13] = qw(th th th);
+@Dsuf[30,31] = qw(th st);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/German.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/German.pm
new file mode 100644
index 0000000000..11242c4c46
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/German.pm
@@ -0,0 +1,37 @@
+##
+## German tables
+##
+
+package Date::Language::German;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.02";
+
+@MoY = qw(Januar Februar März April Mai Juni
+ Juli August September Oktober November Dezember);
+@MoYs = qw(Jan Feb Mär Apr Mai Jun Jul Aug Sep Okt Nov Dez);
+@DoW = qw(Sonntag Montag Dienstag Mittwoch Donnerstag Freitag Samstag);
+@DoWs = qw(Son Mon Die Mit Don Fre Sam);
+
+use Date::Language::English ();
+@AMPM = @{Date::Language::English::AMPM};
+@Dsuf = @{Date::Language::English::Dsuf};
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_o { sprintf("%2d.",$_[0]->[3]) }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Greek.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Greek.pm
new file mode 100644
index 0000000000..00f917ce47
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Greek.pm
@@ -0,0 +1,91 @@
+##
+## Greek tables
+##
+## Traditional date format is: DoW DD{eta} MoY Year (%A %o %B %Y)
+##
+## Matthew Musgrove <muskrat@mindless.com>
+## Translations gratiously provided by Menelaos Stamatelos <men@kwsn.net>
+## This module returns unicode (utf8) encoded characters. You will need to
+## take the necessary steps for this to display correctly.
+##
+
+package Date::Language::Greek;
+
+use utf8;
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.00";
+
+@DoW = (
+"\x{039a}\x{03c5}\x{03c1}\x{03b9}\x{03b1}\x{03ba}\x{03ae}",
+"\x{0394}\x{03b5}\x{03c5}\x{03c4}\x{03ad}\x{03c1}\x{03b1}",
+"\x{03a4}\x{03c1}\x{03af}\x{03c4}\x{03b7}",
+"\x{03a4}\x{03b5}\x{03c4}\x{03ac}\x{03c1}\x{03c4}\x{03b7}",
+"\x{03a0}\x{03ad}\x{03bc}\x{03c0}\x{03c4}\x{03b7}",
+"\x{03a0}\x{03b1}\x{03c1}\x{03b1}\x{03c3}\x{03ba}\x{03b5}\x{03c5}\x{03ae}",
+"\x{03a3}\x{03ac}\x{03b2}\x{03b2}\x{03b1}\x{03c4}\x{03bf}",
+);
+
+@MoY = (
+"\x{0399}\x{03b1}\x{03bd}\x{03bf}\x{03c5}\x{03b1}\x{03c1}\x{03af}\x{03bf}\x{03c5}",
+"\x{03a6}\x{03b5}\x{03b2}\x{03c1}\x{03bf}\x{03c5}\x{03b1}\x{03c1}\x{03af}\x{03bf}\x{03c5}",
+"\x{039c}\x{03b1}\x{03c1}\x{03c4}\x{03af}\x{03bf}\x{03c5}",
+"\x{0391}\x{03c0}\x{03c1}\x{03b9}\x{03bb}\x{03af}\x{03c5}",
+"\x{039c}\x{03b1}\x{0390}\x{03bf}\x{03c5}",
+"\x{0399}\x{03bf}\x{03c5}\x{03bd}\x{03af}\x{03bf}\x{03c5}",
+"\x{0399}\x{03bf}\x{03c5}\x{03bb}\x{03af}\x{03bf}\x{03c5}",
+"\x{0391}\x{03c5}\x{03b3}\x{03bf}\x{03cd}\x{03c3}\x{03c4}\x{03bf}\x{03c5}",
+"\x{03a3}\x{03b5}\x{03c0}\x{03c4}\x{03b5}\x{03bc}\x{03c4}\x{03bf}\x{03c5}",
+"\x{039f}\x{03ba}\x{03c4}\x{03c9}\x{03b2}\x{03c1}\x{03af}\x{03bf}\x{03c5}",
+"\x{039d}\x{03bf}\x{03b5}\x{03bc}\x{03b2}\x{03c1}\x{03af}\x{03bf}\x{03c5}",
+"\x{0394}\x{03b5}\x{03ba}\x{03b5}\x{03bc}\x{03b2}\x{03c1}\x{03bf}\x{03c5}",
+);
+
+@DoWs = (
+"\x{039a}\x{03c5}",
+"\x{0394}\x{03b5}",
+"\x{03a4}\x{03c1}",
+"\x{03a4}\x{03b5}",
+"\x{03a0}\x{03b5}",
+"\x{03a0}\x{03b1}",
+"\x{03a3}\x{03b1}",
+);
+@MoYs = (
+"\x{0399}\x{03b1}\x{03bd}",
+"\x{03a6}\x{03b5}",
+"\x{039c}\x{03b1}\x{03c1}",
+"\x{0391}\x{03c0}\x{03c1}",
+"\x{039c}\x{03b1}",
+"\x{0399}\x{03bf}\x{03c5}\x{03bd}",
+"\x{0399}\x{03bf}\x{03c5}\x{03bb}",
+"\x{0391}\x{03c5}\x{03b3}",
+"\x{03a3}\x{03b5}\x{03c0}",
+"\x{039f}\x{03ba}",
+"\x{039d}\x{03bf}",
+"\x{0394}\x{03b5}",
+);
+
+@AMPM = ("\x{03c0}\x{03bc}", "\x{03bc}\x{03bc}");
+
+@Dsuf = ("\x{03b7}" x 31);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_o { sprintf("%2d%s",$_[0]->[3],"\x{03b7}") }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
+
+
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Hungarian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Hungarian.pm
new file mode 100644
index 0000000000..d9c838d15b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Hungarian.pm
@@ -0,0 +1,88 @@
+##
+## Hungarian tables based on English
+##
+#
+# This is a just-because-I-stumbled-across-it
+# -and-my-wife-is-Hungarian release: if Graham or
+# someone adds to docs to Date::Format, I'd be
+# glad to correct bugs and extend as neeed.
+#
+
+package Date::Language::Hungarian;
+
+=head1 NAME
+
+Date::Language::Hungarian - Magyar format for Date::Format
+
+=head1 SYNOPSIS
+
+ my $lang = Date::Language->new('Hungarian');
+ print $lang->time2str("%a %b %e %T %Y", time);
+
+ @lt = localtime(time);
+ print $lang->time2str($template, time);
+ print $lang->strftime($template, @lt);
+
+ print $lang->time2str($template, time, $zone);
+ print $lang->strftime($template, @lt, $zone);
+
+ print $lang->ctime(time);
+ print $lang->asctime(@lt);
+
+ print $lang->ctime(time, $zone);
+ print $lang->asctime(@lt, $zone);
+
+See L<Date::Format>.
+
+=head1 AUTHOR
+
+Paula Goddard (paula -at- paulacska -dot- com)
+
+=head1 LICENCE
+
+Made available under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use warnings;
+use base "Date::Language";
+use vars qw( @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+$VERSION = "1.01";
+
+@DoW = qw(Vasárnap Hétfõ Kedd Szerda Csütörtök Péntek Szombat);
+@MoY = qw(Január Február Március Április Május Június
+ Július Augusztus Szeptember Október November December);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(DE. DU.);
+
+# There is no 'th or 'nd in Hungarian, just a dot
+@Dsuf = (".") x 31;
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_P { lc($_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0]) }
+sub format_o { $_[0]->[3].'.' }
+
+
+
+sub format_D { &format_y . "." . &format_m . "." . &format_d }
+
+sub format_y { sprintf("%02d",$_[0]->[5] % 100) }
+sub format_d { sprintf("%02d",$_[0]->[3]) }
+sub format_m { sprintf("%02d",$_[0]->[4] + 1) }
+
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Icelandic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Icelandic.pm
new file mode 100644
index 0000000000..5ca3ee3209
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Icelandic.pm
@@ -0,0 +1,36 @@
+##
+## Icelandic tables
+##
+
+package Date::Language::Icelandic;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@MoY = qw(Janúar Febrúar Mars Apríl Maí Júni
+ Júli Ágúst September Október Nóvember Desember);
+@MoYs = qw(Jan Feb Mar Apr Maí Jún Júl Ágú Sep Okt Nóv Des);
+@DoW = qw(Sunnudagur Mánudagur Þriðjudagur Miðvikudagur Fimmtudagur Föstudagur Laugardagur Sunnudagur);
+@DoWs = qw(Sun Mán Þri Mið Fim Fös Lau Sun);
+
+use Date::Language::English ();
+@AMPM = @{Date::Language::English::AMPM};
+@Dsuf = @{Date::Language::English::Dsuf};
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Italian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Italian.pm
new file mode 100644
index 0000000000..6db0a8e67c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Italian.pm
@@ -0,0 +1,36 @@
+##
+## Italian tables
+##
+
+package Date::Language::Italian;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@MoY = qw(Gennaio Febbraio Marzo Aprile Maggio Giugno
+ Luglio Agosto Settembre Ottobre Novembre Dicembre);
+@MoYs = qw(Gen Feb Mar Apr Mag Giu Lug Ago Set Ott Nov Dic);
+@DoW = qw(Domenica Lunedi Martedi Mercoledi Giovedi Venerdi Sabato);
+@DoWs = qw(Dom Lun Mar Mer Gio Ven Sab);
+
+use Date::Language::English ();
+@AMPM = @{Date::Language::English::AMPM};
+@Dsuf = @{Date::Language::English::Dsuf};
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Norwegian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Norwegian.pm
new file mode 100644
index 0000000000..bbd997f0b4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Norwegian.pm
@@ -0,0 +1,36 @@
+##
+## Norwegian tables
+##
+
+package Date::Language::Norwegian;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@MoY = qw(Januar Februar Mars April Mai Juni
+ Juli August September Oktober November Desember);
+@MoYs = qw(Jan Feb Mar Apr Mai Jun Jul Aug Sep Okt Nov Des);
+@DoW = qw(Søndag Mandag Tirsdag Onsdag Torsdag Fredag Lørdag Søndag);
+@DoWs = qw(Søn Man Tir Ons Tor Fre Lør Søn);
+
+use Date::Language::English ();
+@AMPM = @{Date::Language::English::AMPM};
+@Dsuf = @{Date::Language::English::Dsuf};
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Oromo.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Oromo.pm
new file mode 100644
index 0000000000..b6a6230c87
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Oromo.pm
@@ -0,0 +1,37 @@
+##
+## Oromo tables
+##
+
+package Date::Language::Oromo;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "0.99";
+
+@DoW = qw(Dilbata Wiixata Qibxata Roobii Kamiisa Jimaata Sanbata);
+@MoY = qw(Amajjii Guraandhala Bitooteessa Elba Caamsa Waxabajjii
+ Adooleessa Hagayya Fuulbana Onkololeessa Sadaasa Muddee);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(WD WB);
+
+@Dsuf = (qw(th st nd rd th th th th th th)) x 3;
+@Dsuf[11,12,13] = qw(th th th);
+@Dsuf[30,31] = qw(th st);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Romanian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Romanian.pm
new file mode 100644
index 0000000000..cbd2c8cbc4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Romanian.pm
@@ -0,0 +1,37 @@
+##
+## Italian tables
+##
+
+package Date::Language::Romanian;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@MoY = qw(ianuarie februarie martie aprilie mai iunie
+ iulie august septembrie octombrie noembrie decembrie);
+@DoW = qw(duminica luni marti miercuri joi vineri sambata);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+
+@AMPM = qw(AM PM);
+
+@Dsuf = ('') x 31;
+
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian.pm
new file mode 100644
index 0000000000..ca9f414232
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian.pm
@@ -0,0 +1,49 @@
+##
+## Russian tables
+##
+## Contributed by Danil Pismenny <dapi@mail.ru>
+
+package Date::Language::Russian;
+
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @MoY2 @AMPM %MoY %DoW $VERSION);
+@ISA = qw(Date::Language Date::Format::Generic);
+$VERSION = "1.01";
+
+@MoY = qw(ñÎ×ÁÒÑ æÅ×ÒÁÌÑ íÁÒÔÁ áÐÒÅÌÑ íÁÑ éÀÎÑ éÀÌÑ á×ÇÕÓÔÁ óÅÎÔÑÂÒÑ ïËÔÑÂÒÑ îÏÑÂÒÑ äÅËÁÂÒÑ);
+@MoY2 = qw(ñÎ×ÁÒØ æÅ×ÒÁÌØ íÁÒÔ áÐÒÅÌØ íÁÊ éÀÎØ éÀÌØ á×ÇÕÓÔ óÅÎÔÑÂÒØ ïËÔÑÂÒØ îÏÑÂÒØ äÅËÁÂÒØ);
+@MoYs = qw(ñÎ× æÅ× íÒÔ áÐÒ íÁÊ éÀÎ éÀÌ á×Ç óÅÎ ïËÔ îÏÑ äÅË);
+
+@DoW = qw(ðÏÎÅÄÅÌØÎÉË ÷ÔÏÒÎÉË óÒÅÄÁ þÅÔ×ÅÒÇ ðÑÔÎÉÃÁ óÕÂÂÏÔÁ ÷ÏÓËÒÅÓÅÎØÅ);
+@DoWs = qw(ðÎ ÷Ô óÒ þÔ ðÔ ó ÷Ó);
+@DoWs2 = qw(ðÎÄ ÷ÔÒ óÒÄ þÔ× ðÔÎ óÂÔ ÷ÓË);
+
+@AMPM = qw(ÄÐ ÐÐ);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+sub format_d { $_[0]->[3] }
+sub format_m { $_[0]->[4] + 1 }
+sub format_o { $_[0]->[3] . '.' }
+
+sub format_Q { $MoY2[$_[0]->[4]] }
+
+sub str2time {
+ my ($self,$value) = @_;
+ map {$value=~s/(\s|^)$DoWs2[$_](\s)/$DoWs[$_]$2/ig} (0..6);
+ $value=~s/(\s+|^)íÁÒ(\s+)/$1íÒÔ$2/;
+ return $self->SUPER::str2time($value);
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian_cp1251.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian_cp1251.pm
new file mode 100644
index 0000000000..cc28e6ed43
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian_cp1251.pm
@@ -0,0 +1,39 @@
+##
+## Russian cp1251
+##
+
+package Date::Language::Russian_cp1251;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@DoW = qw(Âîñêðåñåíüå Ïîíåäåëüíèê Âòîðíèê Ñðåäà ×åòâåðã Ïÿòíèöà Ñóááîòà);
+@MoY = qw(ßíâàðü Ôåâðàëü Ìàðò Àïðåëü Ìàé Èþíü
+ Èþëü Àâãóñò Ñåíòÿáðü Îêòÿáðü Íîÿáðü Äåêàáðü);
+@DoWs = qw(Âñê Ïíä Âòð Ñðä ×òâ Ïòí Ñáò);
+#@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(AM PM);
+
+@Dsuf = ('e') x 31;
+#@Dsuf[11,12,13] = qw(å å å);
+#@Dsuf[30,31] = qw(å å);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_o { sprintf("%2de",$_[0]->[3]) }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian_koi8r.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian_koi8r.pm
new file mode 100644
index 0000000000..53de8d0567
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Russian_koi8r.pm
@@ -0,0 +1,39 @@
+##
+## Russian koi8r
+##
+
+package Date::Language::Russian_koi8r;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@DoW = qw(÷ÏÓËÒÅÓÅÎØÅ ðÏÎÅÄÅÌØÎÉË ÷ÔÏÒÎÉË óÒÅÄÁ þÅÔ×ÅÒÇ ðÑÔÎÉÃÁ óÕÂÂÏÔÁ);
+@MoY = qw(ñÎ×ÁÒØ æÅ×ÒÁÌØ íÁÒÔ áÐÒÅÌØ íÁÊ éÀÎØ
+ éÀÌØ á×ÇÕÓÔ óÅÎÔÑÂÒØ ïËÔÑÂÒØ îÏÑÂÒØ äÅËÁÂÒØ);
+@DoWs = qw(÷ÓË ðÎÄ ÷ÔÒ óÒÄ þÔ× ðÔÎ óÂÔ);
+#@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(AM PM);
+
+@Dsuf = ('e') x 31;
+#@Dsuf[11,12,13] = qw(Å Å Å);
+#@Dsuf[30,31] = qw(Å Å);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_o { sprintf("%2de",$_[0]->[3]) }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Sidama.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Sidama.pm
new file mode 100644
index 0000000000..bc26d7c3f0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Sidama.pm
@@ -0,0 +1,37 @@
+##
+## Sidama tables
+##
+
+package Date::Language::Sidama;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "0.99";
+
+@DoW = qw(Sambata Sanyo Maakisanyo Roowe Hamuse Arbe Qidaame);
+@MoY = qw(January February March April May June
+ July August September October November December);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(soodo hawwaro);
+
+@Dsuf = (qw(th st nd rd th th th th th th)) x 3;
+@Dsuf[11,12,13] = qw(th th th);
+@Dsuf[30,31] = qw(th st);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Somali.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Somali.pm
new file mode 100644
index 0000000000..5b2496170e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Somali.pm
@@ -0,0 +1,62 @@
+##
+## Somali tables
+##
+
+package Date::Language::Somali;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "0.99";
+
+@DoW = qw(Axad Isniin Salaaso Arbaco Khamiis Jimco Sabti);
+@MoY = (
+"Bisha Koobaad",
+"Bisha Labaad",
+"Bisha Saddexaad",
+"Bisha Afraad",
+"Bisha Shanaad",
+"Bisha Lixaad",
+"Bisha Todobaad",
+"Bisha Sideedaad",
+"Bisha Sagaalaad",
+"Bisha Tobnaad",
+"Bisha Kow iyo Tobnaad",
+"Bisha Laba iyo Tobnaad"
+);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = (
+"Kob",
+"Lab",
+"Sad",
+"Afr",
+"Sha",
+"Lix",
+"Tod",
+"Sid",
+"Sag",
+"Tob",
+"KIT",
+"LIT"
+);
+@AMPM = qw(SN GN);
+
+@Dsuf = (qw(th st nd rd th th th th th th)) x 3;
+@Dsuf[11,12,13] = qw(th th th);
+@Dsuf[30,31] = qw(th st);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Spanish.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Spanish.pm
new file mode 100644
index 0000000000..d464ae78ad
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Spanish.pm
@@ -0,0 +1,35 @@
+##
+## Spanish tables
+##
+
+package Date::Language::Spanish;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.00";
+
+@DoW = qw(domingo lunes martes miércoles jueves viernes sábado);
+@MoY = qw(enero febrero marzo abril mayo junio
+ julio agosto septiembre octubre noviembre diciembre);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = qw(AM PM);
+
+@Dsuf = ((qw(ro do ro to to to mo vo no mo)) x 3, 'ro');
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Swedish.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Swedish.pm
new file mode 100644
index 0000000000..8f16594ba7
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Swedish.pm
@@ -0,0 +1,41 @@
+##
+## Swedish tables
+## Contributed by Matthew Musgrove <muskrat@mindless.com>
+## Corrected by dempa
+##
+
+package Date::Language::Swedish;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.01";
+
+@MoY = qw(januari februari mars april maj juni juli augusti september oktober november december);
+@MoYs = map { substr($_,0,3) } @MoY;
+@DoW = map($_ . "dagen", qw(sön mån tis ons tors fre lör));
+@DoWs = map { substr($_,0,2) } @DoW;
+
+# the ordinals are not typically used in modern times
+@Dsuf = ('a' x 2, 'e' x 29);
+
+use Date::Language::English ();
+@AMPM = @{Date::Language::English::AMPM};
+
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+sub format_o { sprintf("%2de",$_[0]->[3]) }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Tigrinya.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Tigrinya.pm
new file mode 100644
index 0000000000..ce4fcb3a1c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Tigrinya.pm
@@ -0,0 +1,58 @@
+##
+## Tigrinya tables
+##
+
+package Date::Language::Tigrinya;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.00";
+
+@DoW = (
+"\x{1230}\x{1295}\x{1260}\x{1275}",
+"\x{1230}\x{1291}\x{12ed}",
+"\x{1230}\x{1209}\x{1235}",
+"\x{1228}\x{1261}\x{12d5}",
+"\x{1213}\x{1219}\x{1235}",
+"\x{12d3}\x{122d}\x{1262}",
+"\x{1240}\x{12f3}\x{121d}"
+);
+@MoY = (
+"\x{1303}\x{1295}\x{12e9}\x{12c8}\x{122a}",
+"\x{134c}\x{1265}\x{1229}\x{12c8}\x{122a}",
+"\x{121b}\x{122d}\x{127d}",
+"\x{12a4}\x{1355}\x{1228}\x{120d}",
+"\x{121c}\x{12ed}",
+"\x{1301}\x{1295}",
+"\x{1301}\x{120b}\x{12ed}",
+"\x{12a6}\x{1308}\x{1235}\x{1275}",
+"\x{1234}\x{1355}\x{1274}\x{121d}\x{1260}\x{122d}",
+"\x{12a6}\x{12ad}\x{1270}\x{12cd}\x{1260}\x{122d}",
+"\x{1296}\x{126c}\x{121d}\x{1260}\x{122d}",
+"\x{12f2}\x{1234}\x{121d}\x{1260}\x{122d}"
+);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = (
+"\x{1295}/\x{1230}",
+"\x{12F5}/\x{1230}"
+);
+
+@Dsuf = ("\x{12ed}" x 31);
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/TigrinyaEritrean.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/TigrinyaEritrean.pm
new file mode 100644
index 0000000000..7ab8d0fdd1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/TigrinyaEritrean.pm
@@ -0,0 +1,93 @@
+##
+## Tigrinya-Eritrean tables
+##
+
+package Date::Language::TigrinyaEritrean;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.00";
+
+if ( $] >= 5.006 ) {
+@DoW = (
+"\x{1230}\x{1295}\x{1260}\x{1275}",
+"\x{1230}\x{1291}\x{12ed}",
+"\x{1230}\x{1209}\x{1235}",
+"\x{1228}\x{1261}\x{12d5}",
+"\x{1213}\x{1219}\x{1235}",
+"\x{12d3}\x{122d}\x{1262}",
+"\x{1240}\x{12f3}\x{121d}"
+);
+@MoY = (
+"\x{1303}\x{1295}\x{12e9}\x{12c8}\x{122a}",
+"\x{134c}\x{1265}\x{1229}\x{12c8}\x{122a}",
+"\x{121b}\x{122d}\x{127d}",
+"\x{12a4}\x{1355}\x{1228}\x{120d}",
+"\x{121c}\x{12ed}",
+"\x{1301}\x{1295}",
+"\x{1301}\x{120b}\x{12ed}",
+"\x{12a6}\x{1308}\x{1235}\x{1275}",
+"\x{1234}\x{1355}\x{1274}\x{121d}\x{1260}\x{122d}",
+"\x{12a6}\x{12ad}\x{1270}\x{12cd}\x{1260}\x{122d}",
+"\x{1296}\x{126c}\x{121d}\x{1260}\x{122d}",
+"\x{12f2}\x{1234}\x{121d}\x{1260}\x{122d}"
+);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = (
+"\x{1295}/\x{1230}",
+"\x{12F5}/\x{1230}"
+);
+
+@Dsuf = ("\x{12ed}" x 31);
+}
+else {
+@DoW = (
+"ሰንበት",
+"ሰኑይ",
+"ሰሉስ",
+"ረቡዕ",
+"ሓሙስ",
+"ዓርቢ",
+"ቀዳáˆ"
+);
+@MoY = (
+"ጥሪ",
+"ለካቲት",
+"መጋቢት",
+"ሚያá‹á‹«",
+"áŒáŠ•á‰¦á‰µ",
+"ሰáŠ",
+"ሓáˆáˆˆ",
+"áŠáˆ“ሰ",
+"መስከረáˆ",
+"ጥቅáˆá‰²",
+"ሕዳር",
+"ታሕሳስ"
+);
+@DoWs = map { substr($_,0,9) } @DoW;
+@MoYs = map { substr($_,0,9) } @MoY;
+@AMPM = (
+"ን/ሰ",
+"ድ/ሰ"
+);
+
+@Dsuf = ("á‹­" x 31);
+}
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/TigrinyaEthiopian.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/TigrinyaEthiopian.pm
new file mode 100644
index 0000000000..84fb7237c3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/TigrinyaEthiopian.pm
@@ -0,0 +1,93 @@
+##
+## Tigrinya-Ethiopian tables
+##
+
+package Date::Language::TigrinyaEthiopian;
+
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION);
+@ISA = qw(Date::Language);
+$VERSION = "1.00";
+
+if ( $] >= 5.006 ) {
+@DoW = (
+"\x{1230}\x{1295}\x{1260}\x{1275}",
+"\x{1230}\x{1291}\x{12ed}",
+"\x{1230}\x{1209}\x{1235}",
+"\x{1228}\x{1261}\x{12d5}",
+"\x{1213}\x{1219}\x{1235}",
+"\x{12d3}\x{122d}\x{1262}",
+"\x{1240}\x{12f3}\x{121d}"
+);
+@MoY = (
+"\x{1303}\x{1295}\x{12e9}\x{12c8}\x{122a}",
+"\x{134c}\x{1265}\x{1229}\x{12c8}\x{122a}",
+"\x{121b}\x{122d}\x{127d}",
+"\x{12a4}\x{1355}\x{1228}\x{120d}",
+"\x{121c}\x{12ed}",
+"\x{1301}\x{1295}",
+"\x{1301}\x{120b}\x{12ed}",
+"\x{12a6}\x{1308}\x{1235}\x{1275}",
+"\x{1234}\x{1355}\x{1274}\x{121d}\x{1260}\x{122d}",
+"\x{12a6}\x{12ad}\x{1270}\x{12cd}\x{1260}\x{122d}",
+"\x{1296}\x{126c}\x{121d}\x{1260}\x{122d}",
+"\x{12f2}\x{1234}\x{121d}\x{1260}\x{122d}"
+);
+@DoWs = map { substr($_,0,3) } @DoW;
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = (
+"\x{1295}/\x{1230}",
+"\x{12F5}/\x{1230}"
+);
+
+@Dsuf = ("\x{12ed}" x 31);
+}
+else {
+@DoW = (
+"ሰንበት",
+"ሰኑይ",
+"ሰሉስ",
+"ረቡዕ",
+"ሓሙስ",
+"ዓርቢ",
+"ቀዳáˆ"
+);
+@MoY = (
+"ጃንዩወሪ",
+"áŒá‰¥áˆ©á‹ˆáˆª",
+"ማርች",
+"ኤá•áˆ¨áˆ",
+"ሜይ",
+"áŒáŠ•",
+"áŒáˆ‹á‹­",
+"ኦገስት",
+"ሴá•á‰´áˆá‰ áˆ­",
+"ኦክተá‹á‰ áˆ­",
+"ኖቬáˆá‰ áˆ­",
+"ዲሴáˆá‰ áˆ­"
+);
+@DoWs = map { substr($_,0,9) } @DoW;
+@MoYs = map { substr($_,0,9) } @MoY;
+@AMPM = (
+"ን/ሰ",
+"ድ/ሰ"
+);
+
+@Dsuf = ("á‹­" x 31);
+}
+
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[$_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[$_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { $_[0]->[2] >= 12 ? $AMPM[1] : $AMPM[0] }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Turkish.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Turkish.pm
new file mode 100644
index 0000000000..593e20925c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Language/Turkish.pm
@@ -0,0 +1,59 @@
+#----------------------------------------------------#
+#
+# Turkish tables
+# Burak Gürsoy <burak@cpan.org>
+# Last modified: Sat Nov 15 20:28:32 2003
+#
+# use Date::Language;
+# my $turkish = Date::Language->new('Turkish');
+# print $turkish->time2str("%e %b %Y, %a %T\n", time);
+# print $turkish->str2time("25 Haz 1996 21:09:55 +0100");
+#----------------------------------------------------#
+
+package Date::Language::Turkish;
+use Date::Language ();
+use vars qw(@ISA @DoW @DoWs @MoY @MoYs @AMPM @Dsuf %MoY %DoW $VERSION %DsufMAP);
+@ISA = qw(Date::Language);
+$VERSION = "1.0";
+
+@DoW = qw(Pazar Pazartesi Salý Çarþamba Perþembe Cuma Cumartesi);
+@MoY = qw(Ocak Þubat Mart Nisan Mayýs Haziran Temmuz Aðustos Eylül Ekim Kasým Aralýk);
+@DoWs = map { substr($_,0,3) } @DoW;
+$DoWs[1] = 'Pzt'; # Since we'll get two 'Paz' s
+$DoWs[-1] = 'Cmt'; # Since we'll get two 'Cum' s
+@MoYs = map { substr($_,0,3) } @MoY;
+@AMPM = ('',''); # no am-pm thingy
+
+# not easy as in english... maybe we can just use a dot "." ? :)
+%DsufMAP = (
+(map {$_ => 'inci', $_+10 => 'inci', $_+20 => 'inci' } 1,2,5,8 ),
+(map {$_ => 'nci', $_+10 => 'nci', $_+20 => 'nci' } 7 ),
+(map {$_ => 'nci', $_+10 => 'nci', $_+20 => 'nci' } 2 ),
+(map {$_ => 'üncü', $_+10 => 'üncü', $_+20 => 'üncü' } 3,4 ),
+(map {$_ => 'uncu', $_+10 => 'uncu', $_+20 => 'uncu' } 9 ),
+(map {$_ => 'ncý', $_+10 => 'ncý', $_+20 => 'ncý' } 6 ),
+(map {$_ => 'uncu', } 10,30 ),
+ 20 => 'nci',
+ 31 => 'inci',
+);
+
+@Dsuf = map{ $DsufMAP{$_} } sort {$a <=> $b} keys %DsufMAP;
+@MoY{@MoY} = (0 .. scalar(@MoY));
+@MoY{@MoYs} = (0 .. scalar(@MoYs));
+@DoW{@DoW} = (0 .. scalar(@DoW));
+@DoW{@DoWs} = (0 .. scalar(@DoWs));
+
+# Formatting routines
+
+sub format_a { $DoWs[$_[0]->[6]] }
+sub format_A { $DoW[ $_[0]->[6]] }
+sub format_b { $MoYs[$_[0]->[4]] }
+sub format_B { $MoY[ $_[0]->[4]] }
+sub format_h { $MoYs[$_[0]->[4]] }
+sub format_p { '' } # disable
+sub format_P { '' } # disable
+sub format_o { sprintf("%2d%s",$_[0]->[3],$Dsuf[$_[0]->[3]-1]) }
+
+1;
+
+__END__
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Parse.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Parse.pm
new file mode 100644
index 0000000000..12b04c14ad
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Date/Parse.pm
@@ -0,0 +1,380 @@
+# Copyright (c) 1995-2009 Graham Barr. This program is free
+# software; you can redistribute it and/or modify it under the same terms
+# as Perl itself.
+
+package Date::Parse;
+
+require 5.000;
+use strict;
+use vars qw($VERSION @ISA @EXPORT);
+use Time::Local;
+use Carp;
+use Time::Zone;
+use Exporter;
+
+@ISA = qw(Exporter);
+@EXPORT = qw(&strtotime &str2time &strptime);
+
+$VERSION = "2.30";
+
+my %month = (
+ january => 0,
+ february => 1,
+ march => 2,
+ april => 3,
+ may => 4,
+ june => 5,
+ july => 6,
+ august => 7,
+ september => 8,
+ sept => 8,
+ october => 9,
+ november => 10,
+ december => 11,
+ );
+
+my %day = (
+ sunday => 0,
+ monday => 1,
+ tuesday => 2,
+ tues => 2,
+ wednesday => 3,
+ wednes => 3,
+ thursday => 4,
+ thur => 4,
+ thurs => 4,
+ friday => 5,
+ saturday => 6,
+ );
+
+my @suf = (qw(th st nd rd th th th th th th)) x 3;
+@suf[11,12,13] = qw(th th th);
+
+#Abbreviations
+
+map { $month{substr($_,0,3)} = $month{$_} } keys %month;
+map { $day{substr($_,0,3)} = $day{$_} } keys %day;
+
+my $strptime = <<'ESQ';
+ my %month = map { lc $_ } %$mon_ref;
+ my $daypat = join("|", map { lc $_ } reverse sort keys %$day_ref);
+ my $monpat = join("|", reverse sort keys %month);
+ my $sufpat = join("|", reverse sort map { lc $_ } @$suf_ref);
+
+ my %ampm = (
+ 'a' => 0, # AM
+ 'p' => 12, # PM
+ );
+
+ my($AM, $PM) = (0,12);
+
+sub {
+
+ my $dtstr = lc shift;
+ my $merid = 24;
+
+ my($year,$month,$day,$hh,$mm,$ss,$zone,$dst,$frac);
+
+ $zone = tz_offset(shift) if @_;
+
+ 1 while $dtstr =~ s#\([^\(\)]*\)# #o;
+
+ $dtstr =~ s#(\A|\n|\Z)# #sog;
+
+ # ignore day names
+ $dtstr =~ s#([\d\w\s])[\.\,]\s#$1 #sog;
+ $dtstr =~ s/,/ /g;
+ $dtstr =~ s#($daypat)\s*(den\s)?\b# #o;
+ # Time: 12:00 or 12:00:00 with optional am/pm
+
+ return unless $dtstr =~ /\S/;
+
+ if ($dtstr =~ s/\s(\d{4})([-:]?)(\d\d?)\2(\d\d?)(?:[-Tt ](\d\d?)(?:([-:]?)(\d\d?)(?:\6(\d\d?)(?:[.,](\d+))?)?)?)?(?=\D)/ /) {
+ ($year,$month,$day,$hh,$mm,$ss,$frac) = ($1,$3-1,$4,$5,$7,$8,$9);
+ }
+
+ unless (defined $hh) {
+ if ($dtstr =~ s#[:\s](\d\d?):(\d\d?)(:(\d\d?)(?:\.\d+)?)?(z)?\s*(?:([ap])\.?m?\.?)?\s# #o) {
+ ($hh,$mm,$ss) = ($1,$2,$4);
+ $zone = 0 if $5;
+ $merid = $ampm{$6} if $6;
+ }
+
+ # Time: 12 am
+
+ elsif ($dtstr =~ s#\s(\d\d?)\s*([ap])\.?m?\.?\s# #o) {
+ ($hh,$mm,$ss) = ($1,0,0);
+ $merid = $ampm{$2};
+ }
+ }
+
+ if (defined $hh and $hh <= 12 and $dtstr =~ s# ([ap])\.?m?\.?\s# #o) {
+ $merid = $ampm{$1};
+ }
+
+
+ unless (defined $year) {
+ # Date: 12-June-96 (using - . or /)
+
+ if ($dtstr =~ s#\s(\d\d?)([\-\./])($monpat)(\2(\d\d+))?\s# #o) {
+ ($month,$day) = ($month{$3},$1);
+ $year = $5 if $5;
+ }
+
+ # Date: 12-12-96 (using '-', '.' or '/' )
+
+ elsif ($dtstr =~ s#\s(\d+)([\-\./])(\d\d?)(\2(\d+))?\s# #o) {
+ ($month,$day) = ($1 - 1,$3);
+
+ if ($5) {
+ $year = $5;
+ # Possible match for 1995-01-24 (short mainframe date format);
+ ($year,$month,$day) = ($1, $3 - 1, $5) if $month > 12;
+ return if length($year) > 2 and $year < 1901;
+ }
+ }
+ elsif ($dtstr =~ s#\s(\d+)\s*($sufpat)?\s*($monpat)# #o) {
+ ($month,$day) = ($month{$3},$1);
+ }
+ elsif ($dtstr =~ s#($monpat)\s*(\d+)\s*($sufpat)?\s# #o) {
+ ($month,$day) = ($month{$1},$2);
+ }
+ elsif ($dtstr =~ s#($monpat)([\/-])(\d+)[\/-]# #o) {
+ ($month,$day) = ($month{$1},$3);
+ }
+
+ # Date: 961212
+
+ elsif ($dtstr =~ s#\s(\d\d)(\d\d)(\d\d)\s# #o) {
+ ($year,$month,$day) = ($1,$2-1,$3);
+ }
+
+ $year = $1 if !defined($year) and $dtstr =~ s#\s(\d{2}(\d{2})?)[\s\.,]# #o;
+
+ }
+
+ # Zone
+
+ $dst = 1 if $dtstr =~ s#\bdst\b##o;
+
+ if ($dtstr =~ s#\s"?([a-z]{3,4})(dst|\d+[a-z]*|_[a-z]+)?"?\s# #o) {
+ $dst = 1 if $2 and $2 eq 'dst';
+ $zone = tz_offset($1);
+ return unless defined $zone;
+ }
+ elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?):?(\d\d)?(00)?\s# #o) {
+ my $m = defined($4) ? "$2$4" : 0;
+ my $h = "$2$3";
+ $zone = defined($1) ? tz_offset($1) : 0;
+ return unless defined $zone;
+ $zone += 60 * ($m + (60 * $h));
+ }
+
+ if ($dtstr =~ /\S/) {
+ # now for some dumb dates
+ if ($dtstr =~ s/^\s*(ut?|z)\s*$//) {
+ $zone = 0;
+ }
+ elsif ($dtstr =~ s#\s([a-z]{3,4})?([\-\+]?)-?(\d\d?)(\d\d)?(00)?\s# #o) {
+ my $m = defined($4) ? "$2$4" : 0;
+ my $h = "$2$3";
+ $zone = defined($1) ? tz_offset($1) : 0;
+ return unless defined $zone;
+ $zone += 60 * ($m + (60 * $h));
+ }
+
+ return if $dtstr =~ /\S/o;
+ }
+
+ if (defined $hh) {
+ if ($hh == 12) {
+ $hh = 0 if $merid == $AM;
+ }
+ elsif ($merid == $PM) {
+ $hh += 12;
+ }
+ }
+
+ $year -= 1900 if defined $year && $year > 1900;
+
+ $zone += 3600 if defined $zone && $dst;
+ $ss += "0.$frac" if $frac;
+
+ return ($ss,$mm,$hh,$day,$month,$year,$zone);
+}
+ESQ
+
+use vars qw($day_ref $mon_ref $suf_ref $obj);
+
+sub gen_parser
+{
+ local($day_ref,$mon_ref,$suf_ref,$obj) = @_;
+
+ if($obj)
+ {
+ my $obj_strptime = $strptime;
+ substr($obj_strptime,index($strptime,"sub")+6,0) = <<'ESQ';
+ shift; # package
+ESQ
+ my $sub = eval "$obj_strptime" or die $@;
+ return $sub;
+ }
+
+ eval "$strptime" or die $@;
+
+}
+
+*strptime = gen_parser(\%day,\%month,\@suf);
+
+sub str2time
+{
+ my @t = strptime(@_);
+
+ return undef
+ unless @t;
+
+ my($ss,$mm,$hh,$day,$month,$year,$zone) = @t;
+ my @lt = localtime(time);
+
+ $hh ||= 0;
+ $mm ||= 0;
+ $ss ||= 0;
+
+ my $frac = $ss - int($ss);
+ $ss = int $ss;
+
+ $month = $lt[4]
+ unless(defined $month);
+
+ $day = $lt[3]
+ unless(defined $day);
+
+ $year = ($month > $lt[4]) ? ($lt[5] - 1) : $lt[5]
+ unless(defined $year);
+
+ return undef
+ unless($month <= 11 && $day >= 1 && $day <= 31
+ && $hh <= 23 && $mm <= 59 && $ss <= 59);
+
+ my $result;
+
+ if (defined $zone) {
+ $result = eval {
+ local $SIG{__DIE__} = sub {}; # Ick!
+ timegm($ss,$mm,$hh,$day,$month,$year);
+ };
+ return undef
+ if !defined $result
+ or $result == -1
+ && join("",$ss,$mm,$hh,$day,$month,$year)
+ ne "595923311169";
+ $result -= $zone;
+ }
+ else {
+ $result = eval {
+ local $SIG{__DIE__} = sub {}; # Ick!
+ timelocal($ss,$mm,$hh,$day,$month,$year);
+ };
+ return undef
+ if !defined $result
+ or $result == -1
+ && join("",$ss,$mm,$hh,$day,$month,$year)
+ ne join("",(localtime(-1))[0..5]);
+ }
+
+ return $result + $frac;
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Date::Parse - Parse date strings into time values
+
+=head1 SYNOPSIS
+
+ use Date::Parse;
+
+ $time = str2time($date);
+
+ ($ss,$mm,$hh,$day,$month,$year,$zone) = strptime($date);
+
+=head1 DESCRIPTION
+
+C<Date::Parse> provides two routines for parsing date strings into time values.
+
+=over 4
+
+=item str2time(DATE [, ZONE])
+
+C<str2time> parses C<DATE> and returns a unix time value, or undef upon failure.
+C<ZONE>, if given, specifies the timezone to assume when parsing if the
+date string does not specify a timezone.
+
+=item strptime(DATE [, ZONE])
+
+C<strptime> takes the same arguments as str2time but returns an array of
+values C<($ss,$mm,$hh,$day,$month,$year,$zone)>. Elements are only defined
+if they could be extracted from the date string. The C<$zone> element is
+the timezone offset in seconds from GMT. An empty array is returned upon
+failure.
+
+=head1 MULTI-LANGUAGE SUPPORT
+
+Date::Parse is capable of parsing dates in several languages, these include
+English, French, German and Italian.
+
+ $lang = Date::Language->new('German');
+ $lang->str2time("25 Jun 1996 21:09:55 +0100");
+
+=head1 EXAMPLE DATES
+
+Below is a sample list of dates that are known to be parsable with Date::Parse
+
+ 1995:01:24T09:08:17.1823213 ISO-8601
+ 1995-01-24T09:08:17.1823213
+ Wed, 16 Jun 94 07:29:35 CST Comma and day name are optional
+ Thu, 13 Oct 94 10:13:13 -0700
+ Wed, 9 Nov 1994 09:50:32 -0500 (EST) Text in ()'s will be ignored.
+ 21 dec 17:05 Will be parsed in the current time zone
+ 21-dec 17:05
+ 21/dec 17:05
+ 21/dec/93 17:05
+ 1999 10:02:18 "GMT"
+ 16 Nov 94 22:28:20 PST
+
+=head1 LIMITATION
+
+Date::Parse uses L<Time::Local> internally, so is limited to only parsing dates
+which result in valid values for Time::Local::timelocal. This generally means dates
+between 1901-12-17 00:00:00 GMT and 2038-01-16 23:59:59 GMT
+
+=head1 BUGS
+
+When both the month and the date are specified in the date as numbers
+they are always parsed assuming that the month number comes before the
+date. This is the usual format used in American dates.
+
+The reason why it is like this and not dynamic is that it must be
+deterministic. Several people have suggested using the current locale,
+but this will not work as the date being parsed may not be in the format
+of the current locale.
+
+My plans to address this, which will be in a future release, is to allow
+the programmer to state what order they want these values parsed in.
+
+=head1 AUTHOR
+
+Graham Barr <gbarr@pobox.com>
+
+=head1 COPYRIGHT
+
+Copyright (c) 1995-2009 Graham Barr. This program 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/Digest/SHA1.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Digest/SHA1.pm
new file mode 100644
index 0000000000..bd2647a1de
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Digest/SHA1.pm
@@ -0,0 +1,246 @@
+package Digest::SHA1;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT_OK);
+
+$VERSION = '2.13';
+
+require Exporter;
+*import = \&Exporter::import;
+@EXPORT_OK = qw(sha1 sha1_hex sha1_base64 sha1_transform);
+
+require DynaLoader;
+@ISA=qw(DynaLoader);
+
+eval {
+ require Digest::base;
+ push(@ISA, 'Digest::base');
+};
+if ($@) {
+ my $err = $@;
+ *add_bits = sub { die $err };
+}
+
+Digest::SHA1->bootstrap($VERSION);
+
+1;
+__END__
+
+=head1 NAME
+
+Digest::SHA1 - Perl interface to the SHA-1 algorithm
+
+=head1 SYNOPSIS
+
+ # Functional style
+ use Digest::SHA1 qw(sha1 sha1_hex sha1_base64);
+
+ $digest = sha1($data);
+ $digest = sha1_hex($data);
+ $digest = sha1_base64($data);
+ $digest = sha1_transform($data);
+
+
+ # OO style
+ use Digest::SHA1;
+
+ $sha1 = Digest::SHA1->new;
+
+ $sha1->add($data);
+ $sha1->addfile(*FILE);
+
+ $sha1_copy = $sha1->clone;
+
+ $digest = $sha1->digest;
+ $digest = $sha1->hexdigest;
+ $digest = $sha1->b64digest;
+ $digest = $sha1->transform;
+
+=head1 DESCRIPTION
+
+The C<Digest::SHA1> module allows you to use the NIST SHA-1 message
+digest algorithm from within Perl programs. The algorithm takes as
+input a message of arbitrary length and produces as output a 160-bit
+"fingerprint" or "message digest" of the input.
+
+In 2005, security flaws were identified in SHA-1, namely that a possible
+mathematical weakness might exist, indicating that a stronger hash function
+would be desirable. The L<Digest::SHA> module implements the stronger
+algorithms in the SHA family.
+
+The C<Digest::SHA1> module provide a procedural interface for simple
+use, as well as an object oriented interface that can handle messages
+of arbitrary length and which can read files directly.
+
+=head1 FUNCTIONS
+
+The following functions can be exported from the C<Digest::SHA1>
+module. No functions are exported by default.
+
+=over 4
+
+=item sha1($data,...)
+
+This function will concatenate all arguments, calculate the SHA-1
+digest of this "message", and return it in binary form. The returned
+string will be 20 bytes long.
+
+The result of sha1("a", "b", "c") will be exactly the same as the
+result of sha1("abc").
+
+=item sha1_hex($data,...)
+
+Same as sha1(), but will return the digest in hexadecimal form. The
+length of the returned string will be 40 and it will only contain
+characters from this set: '0'..'9' and 'a'..'f'.
+
+=item sha1_base64($data,...)
+
+Same as sha1(), but will return the digest as a base64 encoded string.
+The length of the returned string will be 27 and it will only contain
+characters from this set: 'A'..'Z', 'a'..'z', '0'..'9', '+' and
+'/'.
+
+Note that the base64 encoded string returned is not padded to be a
+multiple of 4 bytes long. If you want interoperability with other
+base64 encoded sha1 digests you might want to append the redundant
+string "=" to the result.
+
+=item sha1_transform($data)
+
+Implements the basic SHA1 transform on a 64 byte block. The $data
+argument and the returned $digest are in binary form. This algorithm
+is used in NIST FIPS 186-2
+
+=back
+
+=head1 METHODS
+
+The object oriented interface to C<Digest::SHA1> is described in this
+section. After a C<Digest::SHA1> object has been created, you will add
+data to it and finally ask for the digest in a suitable format. A
+single object can be used to calculate multiple digests.
+
+The following methods are provided:
+
+=over 4
+
+=item $sha1 = Digest::SHA1->new
+
+The constructor returns a new C<Digest::SHA1> object which encapsulate
+the state of the SHA-1 message-digest algorithm.
+
+If called as an instance method (i.e. $sha1->new) it will just reset the
+state the object to the state of a newly created object. No new
+object is created in this case.
+
+=item $sha1->reset
+
+This is just an alias for $sha1->new.
+
+=item $sha1->clone
+
+This a copy of the $sha1 object. It is useful when you do not want to
+destroy the digests state, but need an intermediate value of the
+digest, e.g. when calculating digests iteratively on a continuous data
+stream. Example:
+
+ my $sha1 = Digest::SHA1->new;
+ while (<>) {
+ $sha1->add($_);
+ print "Line $.: ", $sha1->clone->hexdigest, "\n";
+ }
+
+=item $sha1->add($data,...)
+
+The $data provided as argument are appended to the message we
+calculate the digest for. The return value is the $sha1 object itself.
+
+All these lines will have the same effect on the state of the $sha1
+object:
+
+ $sha1->add("a"); $sha1->add("b"); $sha1->add("c");
+ $sha1->add("a")->add("b")->add("c");
+ $sha1->add("a", "b", "c");
+ $sha1->add("abc");
+
+=item $sha1->addfile($io_handle)
+
+The $io_handle will be read until EOF and its content appended to the
+message we calculate the digest for. The return value is the $sha1
+object itself.
+
+The addfile() method will croak() if it fails reading data for some
+reason. If it croaks it is unpredictable what the state of the $sha1
+object will be in. The addfile() method might have been able to read
+the file partially before it failed. It is probably wise to discard
+or reset the $sha1 object if this occurs.
+
+In most cases you want to make sure that the $io_handle is in
+C<binmode> before you pass it as argument to the addfile() method.
+
+=item $sha1->add_bits($data, $nbits)
+
+=item $sha1->add_bits($bitstring)
+
+This implementation of SHA-1 only supports byte oriented input so you
+might only add bits as multiples of 8. If you need bit level support
+please consider using the C<Digest::SHA> module instead. The
+add_bits() method is provided here for compatibility with other digest
+implementations. See L<Digest> for description of the arguments that
+add_bits() take.
+
+=item $sha1->digest
+
+Return the binary digest for the message. The returned string will be
+20 bytes long.
+
+Note that the C<digest> operation is effectively a destructive,
+read-once operation. Once it has been performed, the C<Digest::SHA1>
+object is automatically C<reset> and can be used to calculate another
+digest value. Call $sha1->clone->digest if you want to calculate the
+digest without reseting the digest state.
+
+=item $sha1->hexdigest
+
+Same as $sha1->digest, but will return the digest in hexadecimal
+form. The length of the returned string will be 40 and it will only
+contain characters from this set: '0'..'9' and 'a'..'f'.
+
+=item $sha1->b64digest
+
+Same as $sha1->digest, but will return the digest as a base64 encoded
+string. The length of the returned string will be 27 and it will only
+contain characters from this set: 'A'..'Z', 'a'..'z', '0'..'9', '+'
+and '/'.
+
+
+The base64 encoded string returned is not padded to be a multiple of 4
+bytes long. If you want interoperability with other base64 encoded
+SHA-1 digests you might want to append the string "=" to the result.
+
+=back
+
+=head1 SEE ALSO
+
+L<Digest>, L<Digest::HMAC_SHA1>, L<Digest::SHA>, L<Digest::MD5>
+
+http://www.itl.nist.gov/fipspubs/fip180-1.htm
+
+http://en.wikipedia.org/wiki/SHA_hash_functions
+
+=head1 COPYRIGHT
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+ Copyright 1999-2004 Gisle Aas.
+ Copyright 1997 Uwe Hollerbach.
+
+=head1 AUTHORS
+
+Peter C. Gutmann,
+Uwe Hollerbach <uh@alumni.caltech.edu>,
+Gisle Aas <gisle@aas.no>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/Locale.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/Locale.pm
new file mode 100644
index 0000000000..1933778f4b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/Locale.pm
@@ -0,0 +1,373 @@
+package Encode::Locale;
+
+use strict;
+our $VERSION = "1.05";
+
+use base 'Exporter';
+our @EXPORT_OK = qw(
+ decode_argv env
+ $ENCODING_LOCALE $ENCODING_LOCALE_FS
+ $ENCODING_CONSOLE_IN $ENCODING_CONSOLE_OUT
+);
+
+use Encode ();
+use Encode::Alias ();
+
+our $ENCODING_LOCALE;
+our $ENCODING_LOCALE_FS;
+our $ENCODING_CONSOLE_IN;
+our $ENCODING_CONSOLE_OUT;
+
+sub DEBUG () { 0 }
+
+sub _init {
+ if ($^O eq "MSWin32") {
+ unless ($ENCODING_LOCALE) {
+ # Try to obtain what the Windows ANSI code page is
+ eval {
+ unless (defined &GetACP) {
+ require Win32;
+ eval { Win32::GetACP() };
+ *GetACP = sub { &Win32::GetACP } unless $@;
+ }
+ unless (defined &GetACP) {
+ require Win32::API;
+ Win32::API->Import('kernel32', 'int GetACP()');
+ }
+ if (defined &GetACP) {
+ my $cp = GetACP();
+ $ENCODING_LOCALE = "cp$cp" if $cp;
+ }
+ };
+ }
+
+ unless ($ENCODING_CONSOLE_IN) {
+ # only test one since set together
+ unless (defined &GetInputCP) {
+ eval {
+ require Win32;
+ eval { Win32::GetConsoleCP() };
+ # manually "import" it since Win32->import refuses
+ *GetInputCP = sub { &Win32::GetConsoleCP } unless $@;
+ *GetOutputCP = sub { &Win32::GetConsoleOutputCP } unless $@;
+ };
+ unless (defined &GetInputCP) {
+ eval {
+ # try Win32::Console module for codepage to use
+ require Win32::Console;
+ eval { Win32::Console::InputCP() };
+ *GetInputCP = sub { &Win32::Console::InputCP }
+ unless $@;
+ *GetOutputCP = sub { &Win32::Console::OutputCP }
+ unless $@;
+ };
+ }
+ unless (defined &GetInputCP) {
+ # final fallback
+ *GetInputCP = *GetOutputCP = sub {
+ # another fallback that could work is:
+ # reg query HKLM\System\CurrentControlSet\Control\Nls\CodePage /v ACP
+ ((qx(chcp) || '') =~ /^Active code page: (\d+)/)
+ ? $1 : ();
+ };
+ }
+ }
+ my $cp = GetInputCP();
+ $ENCODING_CONSOLE_IN = "cp$cp" if $cp;
+ $cp = GetOutputCP();
+ $ENCODING_CONSOLE_OUT = "cp$cp" if $cp;
+ }
+ }
+
+ unless ($ENCODING_LOCALE) {
+ eval {
+ require I18N::Langinfo;
+ $ENCODING_LOCALE = I18N::Langinfo::langinfo(I18N::Langinfo::CODESET());
+
+ # Workaround of Encode < v2.25. The "646" encoding alias was
+ # introduced in Encode-2.25, but we don't want to require that version
+ # quite yet. Should avoid the CPAN testers failure reported from
+ # openbsd-4.7/perl-5.10.0 combo.
+ $ENCODING_LOCALE = "ascii" if $ENCODING_LOCALE eq "646";
+
+ # https://rt.cpan.org/Ticket/Display.html?id=66373
+ $ENCODING_LOCALE = "hp-roman8" if $^O eq "hpux" && $ENCODING_LOCALE eq "roman8";
+ };
+ $ENCODING_LOCALE ||= $ENCODING_CONSOLE_IN;
+ }
+
+ if ($^O eq "darwin") {
+ $ENCODING_LOCALE_FS ||= "UTF-8";
+ }
+
+ # final fallback
+ $ENCODING_LOCALE ||= $^O eq "MSWin32" ? "cp1252" : "UTF-8";
+ $ENCODING_LOCALE_FS ||= $ENCODING_LOCALE;
+ $ENCODING_CONSOLE_IN ||= $ENCODING_LOCALE;
+ $ENCODING_CONSOLE_OUT ||= $ENCODING_CONSOLE_IN;
+
+ unless (Encode::find_encoding($ENCODING_LOCALE)) {
+ my $foundit;
+ if (lc($ENCODING_LOCALE) eq "gb18030") {
+ eval {
+ require Encode::HanExtra;
+ };
+ if ($@) {
+ die "Need Encode::HanExtra to be installed to support locale codeset ($ENCODING_LOCALE), stopped";
+ }
+ $foundit++ if Encode::find_encoding($ENCODING_LOCALE);
+ }
+ die "The locale codeset ($ENCODING_LOCALE) isn't one that perl can decode, stopped"
+ unless $foundit;
+
+ }
+
+ # use Data::Dump; ddx $ENCODING_LOCALE, $ENCODING_LOCALE_FS, $ENCODING_CONSOLE_IN, $ENCODING_CONSOLE_OUT;
+}
+
+_init();
+Encode::Alias::define_alias(sub {
+ no strict 'refs';
+ no warnings 'once';
+ return ${"ENCODING_" . uc(shift)};
+}, "locale");
+
+sub _flush_aliases {
+ no strict 'refs';
+ for my $a (keys %Encode::Alias::Alias) {
+ if (defined ${"ENCODING_" . uc($a)}) {
+ delete $Encode::Alias::Alias{$a};
+ warn "Flushed alias cache for $a" if DEBUG;
+ }
+ }
+}
+
+sub reinit {
+ $ENCODING_LOCALE = shift;
+ $ENCODING_LOCALE_FS = shift;
+ $ENCODING_CONSOLE_IN = $ENCODING_LOCALE;
+ $ENCODING_CONSOLE_OUT = $ENCODING_LOCALE;
+ _init();
+ _flush_aliases();
+}
+
+sub decode_argv {
+ die if defined wantarray;
+ for (@ARGV) {
+ $_ = Encode::decode(locale => $_, @_);
+ }
+}
+
+sub env {
+ my $k = Encode::encode(locale => shift);
+ my $old = $ENV{$k};
+ if (@_) {
+ my $v = shift;
+ if (defined $v) {
+ $ENV{$k} = Encode::encode(locale => $v);
+ }
+ else {
+ delete $ENV{$k};
+ }
+ }
+ return Encode::decode(locale => $old) if defined wantarray;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Encode::Locale - Determine the locale encoding
+
+=head1 SYNOPSIS
+
+ use Encode::Locale;
+ use Encode;
+
+ $string = decode(locale => $bytes);
+ $bytes = encode(locale => $string);
+
+ if (-t) {
+ binmode(STDIN, ":encoding(console_in)");
+ binmode(STDOUT, ":encoding(console_out)");
+ binmode(STDERR, ":encoding(console_out)");
+ }
+
+ # Processing file names passed in as arguments
+ my $uni_filename = decode(locale => $ARGV[0]);
+ open(my $fh, "<", encode(locale_fs => $uni_filename))
+ || die "Can't open '$uni_filename': $!";
+ binmode($fh, ":encoding(locale)");
+ ...
+
+=head1 DESCRIPTION
+
+In many applications it's wise to let Perl use Unicode for the strings it
+processes. Most of the interfaces Perl has to the outside world are still byte
+based. Programs therefore need to decode byte strings that enter the program
+from the outside and encode them again on the way out.
+
+The POSIX locale system is used to specify both the language conventions
+requested by the user and the preferred character set to consume and
+output. The C<Encode::Locale> module looks up the charset and encoding (called
+a CODESET in the locale jargon) and arranges for the L<Encode> module to know
+this encoding under the name "locale". It means bytes obtained from the
+environment can be converted to Unicode strings by calling C<<
+Encode::encode(locale => $bytes) >> and converted back again with C<<
+Encode::decode(locale => $string) >>.
+
+Where file systems interfaces pass file names in and out of the program we also
+need care. The trend is for operating systems to use a fixed file encoding
+that don't actually depend on the locale; and this module determines the most
+appropriate encoding for file names. The L<Encode> module will know this
+encoding under the name "locale_fs". For traditional Unix systems this will
+be an alias to the same encoding as "locale".
+
+For programs running in a terminal window (called a "Console" on some systems)
+the "locale" encoding is usually a good choice for what to expect as input and
+output. Some systems allows us to query the encoding set for the terminal and
+C<Encode::Locale> will do that if available and make these encodings known
+under the C<Encode> aliases "console_in" and "console_out". For systems where
+we can't determine the terminal encoding these will be aliased as the same
+encoding as "locale". The advice is to use "console_in" for input known to
+come from the terminal and "console_out" for output to the terminal.
+
+In addition to arranging for various Encode aliases the following functions and
+variables are provided:
+
+=over
+
+=item decode_argv( )
+
+=item decode_argv( Encode::FB_CROAK )
+
+This will decode the command line arguments to perl (the C<@ARGV> array) in-place.
+
+The function will by default replace characters that can't be decoded by
+"\x{FFFD}", the Unicode replacement character.
+
+Any argument provided is passed as CHECK to underlying Encode::decode() call.
+Pass the value C<Encode::FB_CROAK> to have the decoding croak if not all the
+command line arguments can be decoded. See L<Encode/"Handling Malformed Data">
+for details on other options for CHECK.
+
+=item env( $uni_key )
+
+=item env( $uni_key => $uni_value )
+
+Interface to get/set environment variables. Returns the current value as a
+Unicode string. The $uni_key and $uni_value arguments are expected to be
+Unicode strings as well. Passing C<undef> as $uni_value deletes the
+environment variable named $uni_key.
+
+The returned value will have the characters that can't be decoded replaced by
+"\x{FFFD}", the Unicode replacement character.
+
+There is no interface to request alternative CHECK behavior as for
+decode_argv(). If you need that you need to call encode/decode yourself.
+For example:
+
+ my $key = Encode::encode(locale => $uni_key, Encode::FB_CROAK);
+ my $uni_value = Encode::decode(locale => $ENV{$key}, Encode::FB_CROAK);
+
+=item reinit( )
+
+=item reinit( $encoding )
+
+Reinitialize the encodings from the locale. You want to call this function if
+you changed anything in the environment that might influence the locale.
+
+This function will croak if the determined encoding isn't recognized by
+the Encode module.
+
+With argument force $ENCODING_... variables to set to the given value.
+
+=item $ENCODING_LOCALE
+
+The encoding name determined to be suitable for the current locale.
+L<Encode> know this encoding as "locale".
+
+=item $ENCODING_LOCALE_FS
+
+The encoding name determined to be suitable for file system interfaces
+involving file names.
+L<Encode> know this encoding as "locale_fs".
+
+=item $ENCODING_CONSOLE_IN
+
+=item $ENCODING_CONSOLE_OUT
+
+The encodings to be used for reading and writing output to the a console.
+L<Encode> know these encodings as "console_in" and "console_out".
+
+=back
+
+=head1 NOTES
+
+This table summarizes the mapping of the encodings set up
+by the C<Encode::Locale> module:
+
+ Encode | | |
+ Alias | Windows | Mac OS X | POSIX
+ ------------+---------+--------------+------------
+ locale | ANSI | nl_langinfo | nl_langinfo
+ locale_fs | ANSI | UTF-8 | nl_langinfo
+ console_in | OEM | nl_langinfo | nl_langinfo
+ console_out | OEM | nl_langinfo | nl_langinfo
+
+=head2 Windows
+
+Windows has basically 2 sets of APIs. A wide API (based on passing UTF-16
+strings) and a byte based API based a character set called ANSI. The
+regular Perl interfaces to the OS currently only uses the ANSI APIs.
+Unfortunately ANSI is not a single character set.
+
+The encoding that corresponds to ANSI varies between different editions of
+Windows. For many western editions of Windows ANSI corresponds to CP-1252
+which is a character set similar to ISO-8859-1. Conceptually the ANSI
+character set is a similar concept to the POSIX locale CODESET so this module
+figures out what the ANSI code page is and make this available as
+$ENCODING_LOCALE and the "locale" Encoding alias.
+
+Windows systems also operate with another byte based character set.
+It's called the OEM code page. This is the encoding that the Console
+takes as input and output. It's common for the OEM code page to
+differ from the ANSI code page.
+
+=head2 Mac OS X
+
+On Mac OS X the file system encoding is always UTF-8 while the locale
+can otherwise be set up as normal for POSIX systems.
+
+File names on Mac OS X will at the OS-level be converted to
+NFD-form. A file created by passing a NFC-filename will come
+in NFD-form from readdir(). See L<Unicode::Normalize> for details
+of NFD/NFC.
+
+Actually, Apple does not follow the Unicode NFD standard since not all
+character ranges are decomposed. The claim is that this avoids problems with
+round trip conversions from old Mac text encodings. See L<Encode::UTF8Mac> for
+details.
+
+=head2 POSIX (Linux and other Unixes)
+
+File systems might vary in what encoding is to be used for
+filenames. Since this module has no way to actually figure out
+what the is correct it goes with the best guess which is to
+assume filenames are encoding according to the current locale.
+Users are advised to always specify UTF-8 as the locale charset.
+
+=head1 SEE ALSO
+
+L<I18N::Langinfo>, L<Encode>, L<Term::Encoding>
+
+=head1 AUTHOR
+
+Copyright 2010 Gisle Aas <gisle@aas.no>.
+
+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/Encode/compat.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat.pm
new file mode 100644
index 0000000000..39432b8f9d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat.pm
@@ -0,0 +1,87 @@
+# $File: //member/autrijus/Encode-compat/lib/Encode/compat.pm $ $Author: autrijus $
+# $Revision: #7 $ $Change: 10735 $ $DateTime: 2004/06/03 14:08:57 $
+
+package Encode::compat;
+$Encode::compat::VERSION = '0.07';
+
+use strict;
+
+if ($] >= 5.007001 or $INC{'Encode.pm'}) {
+ # nothing happens -- Encode.pm already available.
+}
+elsif ($] >= 5.006001 and $] <= 5.007) {
+ require Encode::compat::Alias;
+ $INC{'Encode/Alias.pm'} = $INC{'Encode/compat/Alias.pm'};
+
+ require Encode::compat::common;
+ require Encode::compat::5006001;
+ $INC{'Encode.pm'} = __FILE__;
+}
+else {
+ die "Encode.pm compatibility layer for $] not yet available.";
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Encode::compat - Encode.pm emulation layer
+
+=head1 VERSION
+
+This document describes version 0.07 of Encode::compat, released
+June 3, 2004.
+
+=head1 SYNOPSIS
+
+ use Encode::compat; # a no-op for Perl v5.7.1+
+ use Encode qw(...); # all constants and imports works transparently
+
+ # use Encode functions as normal
+
+=head1 DESCRIPTION
+
+WARNING: THIS IS A PROOF-OF-CONCEPT. Most functions are incomplete.
+All implementation details are subject to change!
+
+This module provide a compatibility layer for B<Encode.pm> users on perl
+versions earlier than v5.7.1. It translates whatever call it receives
+into B<Text::Iconv>, or (in the future) B<Unicode::MapUTF8> to perform
+the actual work.
+
+The C<is_utf8()>, C<_utf8_on()> and C<_utf8_off()> calls are performed
+by the method native to the perl version -- 5.6.1 would use
+C<pack>/C<unpack>, 5.6.0 uses C<tr//CU>, etc.
+
+Theoretically, it could be backported to 5.005 and earlier, with none of
+the unicode-related semantics available, and serves only as a
+abstraction layer above C<Text::Iconv>, C<Unicode::MapUTF8> and possibly
+other transcoding modules.
+
+=head1 CAVEATS
+
+Currently, this module only support 5.6.1+, and merely provides the three
+utility function above (C<encode()>, C<decode()> and C<from_to()>), with
+a very kludgy C<FB_HTMLCREF> fallback against C<latin-1> in
+C<from_to()>.
+
+=head1 SEE ALSO
+
+L<Encode>, L<perlunicode>
+
+=head1 AUTHORS
+
+Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 2002, 2003, 2004 by Autrijus Tang E<lt>autrijus@autrijus.orgE<gt>.
+
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+See L<http://www.perl.com/perl/misc/Artistic.html>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/5006001.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/5006001.pm
new file mode 100644
index 0000000000..cbe2d50180
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/5006001.pm
@@ -0,0 +1,32 @@
+# $File: //member/autrijus/Encode-compat/lib/Encode/compat/5006001.pm $ $Author: autrijus $
+# $Revision: #3 $ $Change: 2534 $ $DateTime: 2002/12/02 00:33:16 $
+
+package Encode::compat::5006001;
+our $VERSION = '0.05';
+
+1;
+
+package Encode;
+
+use strict;
+use base 'Exporter';
+no warnings 'redefine';
+
+sub _utf8_on {
+ $_[0] = pack('U*', unpack('U0U*', $_[0]))
+}
+
+sub _utf8_off {
+ $_[0] = pack('C*', unpack('C*', $_[0]))
+}
+
+sub is_utf8 {
+ # XXX: got any better ideas?
+ use utf8;
+ foreach my $char (split(//, $_[0])) {
+ return 1 if ord($char) > 255;
+ }
+ return 0;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/Alias.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/Alias.pm
new file mode 100644
index 0000000000..6e8d74e6a6
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/Alias.pm
@@ -0,0 +1,330 @@
+# $File: //member/autrijus/.vimrc $ $Author: autrijus $
+# $Revision: #1 $ $Change: 1649 $ $DateTime: 2002/10/24 15:21:23 $
+
+package Encode::compat::Alias;
+our $VERSION = '0.05';
+
+1;
+
+package Encode::Alias;
+use strict;
+our $VERSION = '0.05';
+our $DEBUG = 0;
+
+use base qw(Exporter);
+
+# Public, encouraged API is exported by default
+
+our @EXPORT =
+ qw (
+ define_alias
+ find_alias
+ );
+
+our @Alias; # ordered matching list
+our %Alias; # cached known aliases
+
+sub find_alias
+{
+ my $class = shift;
+ local $_ = shift;
+ unless (exists $Alias{$_})
+ {
+ $Alias{$_} = undef; # Recursion guard
+ for (my $i=0; $i < @Alias; $i += 2)
+ {
+ my $alias = $Alias[$i];
+ my $val = $Alias[$i+1];
+ my $new;
+ if (ref($alias) eq 'Regexp' && $_ =~ $alias)
+ {
+ $DEBUG and warn "eval $val";
+ $new = eval $val;
+ # $@ and warn "$val, $@";
+ }
+ elsif (ref($alias) eq 'CODE')
+ {
+ $DEBUG and warn "$alias", "->", "($val)";
+ $new = $alias->($val);
+ }
+ elsif (lc($_) eq lc($alias))
+ {
+ $new = $val;
+ }
+ if (defined($new))
+ {
+ next if $new eq $_; # avoid (direct) recursion on bugs
+ $DEBUG and warn "$alias, $new";
+ my $enc = (ref($new)) ? $new : Encode::find_encoding($new);
+ if ($enc)
+ {
+ $Alias{$_} = $enc;
+ last;
+ }
+ }
+ }
+ }
+ if ($DEBUG){
+ my $name;
+ if (my $e = $Alias{$_}){
+ $name = $e->name;
+ }else{
+ $name = "";
+ }
+ warn "find_alias($class, $_)->name = $name";
+ }
+ return $Alias{$_};
+}
+
+sub define_alias
+{
+ while (@_)
+ {
+ my ($alias,$name) = splice(@_,0,2);
+ unshift(@Alias, $alias => $name); # newer one has precedence
+ # clear %Alias cache to allow overrides
+ if (ref($alias)){
+ my @a = keys %Alias;
+ for my $k (@a){
+ if (ref($alias) eq 'Regexp' && $k =~ $alias)
+ {
+ $DEBUG and warn "delete \$Alias\{$k\}";
+ delete $Alias{$k};
+ }
+ elsif (ref($alias) eq 'CODE')
+ {
+ $DEBUG and warn "delete \$Alias\{$k\}";
+ delete $Alias{$alias->($name)};
+ }
+ }
+ }else{
+ $DEBUG and warn "delete \$Alias\{$alias\}";
+ delete $Alias{$alias};
+ }
+ }
+}
+
+# Allow latin-1 style names as well
+ # 0 1 2 3 4 5 6 7 8 9 10
+our @Latin2iso = ( 0, 1, 2, 3, 4, 9, 10, 13, 14, 15, 16 );
+# Allow winlatin1 style names as well
+our %Winlatin2cp = (
+ 'latin1' => 1252,
+ 'latin2' => 1250,
+ 'cyrillic' => 1251,
+ 'greek' => 1253,
+ 'turkish' => 1254,
+ 'hebrew' => 1255,
+ 'arabic' => 1256,
+ 'baltic' => 1257,
+ 'vietnamese' => 1258,
+ );
+
+init_aliases();
+
+sub undef_aliases{
+ @Alias = ();
+ %Alias = ();
+}
+
+sub init_aliases
+{
+ undef_aliases();
+
+ # Try all-lower-case version should all else fails
+ define_alias( qr/^(.*)$/ => '"\L$1"' );
+
+ # UTF/UCS stuff
+ define_alias( qr/^UCS-?2-?LE$/i => '"UCS-2LE"' );
+ define_alias( qr/^UCS-?2-?(BE)?$/i => '"UCS-2BE"',
+ qr/^UCS-?4-?(BE|LE)?$/i => 'uc("UTF-32$1")',
+ qr/^iso-10646-1$/i => '"UCS-2BE"' );
+ define_alias( qr/^UTF(16|32)-?BE$/i => '"UTF-$1BE"',
+ qr/^UTF(16|32)-?LE$/i => '"UTF-$1LE"',
+ qr/^UTF(16|32)$/i => '"UTF-$1"',
+ );
+ # ASCII
+ define_alias(qr/^(?:US-?)ascii$/i => '"ascii"');
+ define_alias('C' => 'ascii');
+ define_alias(qr/\bISO[-_]?646[-_]?US$/i => '"ascii"');
+ # Allow variants of iso-8859-1 etc.
+ define_alias( qr/\biso[-_]?(\d+)[-_](\d+)$/i => '"iso-$1-$2"' );
+
+ # At least HP-UX has these.
+ define_alias( qr/\biso8859(\d+)$/i => '"iso-8859-$1"' );
+
+ # More HP stuff.
+ define_alias( qr/\b(?:hp-)?(arabic|greek|hebrew|kana|roman|thai|turkish)8$/i => '"${1}8"' );
+
+ # The Official name of ASCII.
+ define_alias( qr/\bANSI[-_]?X3\.4[-_]?1968$/i => '"ascii"' );
+
+ # This is a font issue, not an encoding issue.
+ # (The currency symbol of the Latin 1 upper half
+ # has been redefined as the euro symbol.)
+ define_alias( qr/^(.+)\@euro$/i => '"$1"' );
+
+ define_alias( qr/\b(?:iso[-_]?)?latin[-_]?(\d+)$/i
+ => 'defined $Encode::Alias::Latin2iso[$1] ? "iso-8859-$Encode::Alias::Latin2iso[$1]" : undef' );
+
+ define_alias( qr/\bwin(latin[12]|cyrillic|baltic|greek|turkish|
+ hebrew|arabic|baltic|vietnamese)$/ix =>
+ '"cp" . $Encode::Alias::Winlatin2cp{lc($1)}' );
+
+ # Common names for non-latin prefered MIME names
+ define_alias( 'ascii' => 'US-ascii',
+ 'cyrillic' => 'iso-8859-5',
+ 'arabic' => 'iso-8859-6',
+ 'greek' => 'iso-8859-7',
+ 'hebrew' => 'iso-8859-8',
+ 'thai' => 'iso-8859-11',
+ 'tis620' => 'iso-8859-11',
+ );
+
+ # At least AIX has IBM-NNN (surprisingly...) instead of cpNNN.
+ # And Microsoft has their own naming (again, surprisingly).
+ # And windows-* is registered in IANA!
+ define_alias( qr/\b(?:cp|ibm|ms|windows)[-_ ]?(\d{2,4})$/i => '"cp$1"');
+
+ # Sometimes seen with a leading zero.
+ # define_alias( qr/\bcp037\b/i => '"cp37"');
+
+ # Mac Mappings
+ # predefined in *.ucm; unneeded
+ # define_alias( qr/\bmacIcelandic$/i => '"macIceland"');
+ define_alias( qr/^mac_(.*)$/i => '"mac$1"');
+ # Ououououou. gone. They are differente!
+ # define_alias( qr/\bmacRomanian$/i => '"macRumanian"');
+
+ # Standardize on the dashed versions.
+ # define_alias( qr/\butf8$/i => 'utf-8' );
+ define_alias( qr/\bkoi8r$/i => 'koi8-r' );
+ define_alias( qr/\bkoi8u$/i => 'koi8-u' );
+
+ unless ($Encode::ON_EBCDIC){
+ # for Encode::CN
+ define_alias( qr/\beuc.*cn$/i => '"euc-cn"' );
+ define_alias( qr/\bcn.*euc$/i => '"euc-cn"' );
+ # define_alias( qr/\bGB[- ]?(\d+)$/i => '"euc-cn"' )
+ # CP936 doesn't have vendor-addon for GBK, so they're identical.
+ define_alias( qr/^gbk$/i => '"cp936"');
+ # This fixes gb2312 vs. euc-cn confusion, practically
+ define_alias( qr/\bGB[-_ ]?2312(?:\D.*$|$)/i => '"euc-cn"' );
+ # for Encode::JP
+ define_alias( qr/\bjis$/i => '"7bit-jis"' );
+ define_alias( qr/\beuc.*jp$/i => '"euc-jp"' );
+ define_alias( qr/\bjp.*euc$/i => '"euc-jp"' );
+ define_alias( qr/\bujis$/i => '"euc-jp"' );
+ define_alias( qr/\bshift.*jis$/i => '"shiftjis"' );
+ define_alias( qr/\bsjis$/i => '"shiftjis"' );
+ # for Encode::KR
+ define_alias( qr/\beuc.*kr$/i => '"euc-kr"' );
+ define_alias( qr/\bkr.*euc$/i => '"euc-kr"' );
+ # This fixes ksc5601 vs. euc-kr confusion, practically
+ define_alias( qr/(?:x-)?uhc$/i => '"cp949"' );
+ define_alias( qr/(?:x-)?windows-949$/i => '"cp949"' );
+ define_alias( qr/\bks_c_5601-1987$/i => '"cp949"' );
+ # for Encode::TW
+ define_alias( qr/\bbig-?5$/i => '"big5-eten"' );
+ define_alias( qr/\bbig5-?et(?:en)?$/i => '"big5-eten"' );
+ define_alias( qr/\btca[-_]?big5$/i => '"big5-eten"' );
+ define_alias( qr/\bbig5-?hk(?:scs)?$/i => '"big5-hkscs"' );
+ define_alias( qr/\bhk(?:scs)?[-_]?big5$/i => '"big5-hkscs"' );
+ }
+ # utf8 is blessed :)
+ define_alias( qr/^UTF-8$/i => '"utf8"',);
+ # At last, Map white space and _ to '-'
+ define_alias( qr/^(\S+)[\s_]+(.*)$/i => '"$1-$2"' );
+}
+
+1;
+__END__
+
+# TODO: HP-UX '8' encodings arabic8 greek8 hebrew8 kana8 thai8 turkish8
+# TODO: HP-UX '15' encodings japanese15 korean15 roi15
+# TODO: Cyrillic encoding ISO-IR-111 (useful?)
+# TODO: Armenian encoding ARMSCII-8
+# TODO: Hebrew encoding ISO-8859-8-1
+# TODO: Thai encoding TCVN
+# TODO: Vietnamese encodings VPS
+# TODO: Mac Asian+African encodings: Arabic Armenian Bengali Burmese
+# ChineseSimp ChineseTrad Devanagari Ethiopic ExtArabic
+# Farsi Georgian Gujarati Gurmukhi Hebrew Japanese
+# Kannada Khmer Korean Laotian Malayalam Mongolian
+# Oriya Sinhalese Symbol Tamil Telugu Tibetan Vietnamese
+
+=head1 NAME
+
+Encode::Alias - alias definitions to encodings
+
+=head1 SYNOPSIS
+
+ use Encode;
+ use Encode::Alias;
+ define_alias( newName => ENCODING);
+
+=head1 DESCRIPTION
+
+Allows newName to be used as an alias for ENCODING. ENCODING may be
+either the name of an encoding or an encoding object (as described
+in L<Encode>).
+
+Currently I<newName> can be specified in the following ways:
+
+=over 4
+
+=item As a simple string.
+
+=item As a qr// compiled regular expression, e.g.:
+
+ define_alias( qr/^iso8859-(\d+)$/i => '"iso-8859-$1"' );
+
+In this case, if I<ENCODING> is not a reference, it is C<eval>-ed
+in order to allow C<$1> etc. to be substituted. The example is one
+way to alias names as used in X11 fonts to the MIME names for the
+iso-8859-* family. Note the double quotes inside the single quotes.
+
+If you are using a regex here, you have to use the quotes as shown or
+it won't work. Also note that regex handling is tricky even for the
+experienced. Use it with caution.
+
+=item As a code reference, e.g.:
+
+ define_alias( sub { return /^iso8859-(\d+)$/i ? "iso-8859-$1" : undef } , '');
+
+In this case, C<$_> will be set to the name that is being looked up and
+I<ENCODING> is passed to the sub as its first argument. The example
+is another way to alias names as used in X11 fonts to the MIME names
+for the iso-8859-* family.
+
+=back
+
+=head2 Alias overloading
+
+You can override predefined aliases by simply applying define_alias().
+The new alias is always evaluated first, and when neccessary,
+define_alias() flushes the internal cache to make the new definition
+available.
+
+ # redirect SHIFT_JIS to MS/IBM Code Page 932, which is a
+ # superset of SHIFT_JIS
+
+ define_alias( qr/shift.*jis$/i => '"cp932"' );
+ define_alias( qr/sjis$/i => '"cp932"' );
+
+If you want to zap all predefined aliases, you can use
+
+ Encode::Alias->undef_aliases;
+
+to do so. And
+
+ Encode::Alias->init_aliases;
+
+gets the factory settings back.
+
+=head1 SEE ALSO
+
+L<Encode>, L<Encode::Supported>
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/common.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/common.pm
new file mode 100644
index 0000000000..f9ba21cb67
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Encode/compat/common.pm
@@ -0,0 +1,127 @@
+# $File: //member/autrijus/Encode-compat/lib/Encode/compat/common.pm $ $Author: autrijus $
+# $Revision: #7 $ $Change: 10024 $ $DateTime: 2004/02/13 21:42:35 $
+
+package Encode::compat::common;
+our $VERSION = '0.06';
+
+1;
+
+package Encode;
+
+use strict;
+our $VERSION = '0.06';
+
+our @EXPORT = qw(
+ decode decode_utf8 encode encode_utf8
+ encodings find_encoding
+);
+
+use constant DIE_ON_ERR => 1;
+use constant WARN_ON_ERR => 2;
+use constant RETURN_ON_ERR => 4;
+use constant LEAVE_SRC => 8;
+
+use constant PERLQQ => 256;
+use constant HTMLCREF => 512;
+use constant XMLCREF => 1024;
+
+use constant FB_DEFAULT => 0;
+use constant FB_CROAK => 1;
+use constant FB_QUIET => 4;
+use constant FB_WARN => 6;
+use constant FB_PERLQQ => 256;
+use constant FB_HTMLCREF => 512;
+use constant FB_XMLCREF => 1024;
+
+our @FB_FLAGS = qw(DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
+ PERLQQ HTMLCREF XMLCREF);
+our @FB_CONSTS = qw(FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
+ FB_PERLQQ FB_HTMLCREF FB_XMLCREF);
+
+our @EXPORT_OK =
+ (
+ qw(
+ _utf8_off _utf8_on define_encoding from_to is_16bit is_8bit
+ is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade
+ ),
+ @FB_FLAGS, @FB_CONSTS,
+ );
+
+our %EXPORT_TAGS =
+ (
+ all => [ @EXPORT, @EXPORT_OK ],
+ fallbacks => [ @FB_CONSTS ],
+ fallback_all => [ @FB_CONSTS, @FB_FLAGS ],
+ );
+
+sub from_to ($$$;$) {
+ use utf8;
+
+ # XXX: bad hack
+ if ($_[3] and $_[3] == FB_HTMLCREF() and lc($_[2]) eq 'latin1') {
+ $_[0] = join('', map {
+ ord($_) < 128
+ ? $_ : '&#' . ord($_) . ';'
+ } split(//, decode($_[1], $_[0])));
+ }
+ else {
+ $_[0] = _convert(@_[0..2]);
+ }
+}
+
+sub encodings {
+ # XXX: revisit
+ require Encode::Alias;
+ return sort values %Encode::Alias::Alias;
+}
+
+sub find_encoding {
+ return $_[0];
+}
+
+sub decode_utf8($;$) {
+ return decode("utf-8", @_);
+}
+
+sub encode_utf8($;$) {
+ return encode("utf-8", @_);
+}
+
+sub decode($$;$) {
+ my $result = ($_[0] =~ /utf-?8/i)
+ ? $_[1] : _convert($_[1], $_[0] => 'utf-8');
+ _utf8_on($result);
+ return $result;
+}
+
+sub encode($$;$) {
+ my $result = ($_[0] =~ /utf-?8/i)
+ ? $_[1] : _convert($_[1], 'utf-8' => $_[0]);
+ _utf8_off($result);
+ return $result;
+}
+
+{
+ my %decoder;
+ sub _convert {
+ require Text::Iconv;
+ Text::Iconv->raise_error(1);
+
+ require Encode::Alias;
+ my ($from, $to) = map {
+ s/^utf8$/utf-8/i;
+ s/^big5-eten$/big5/i;
+ $_;
+ } map {
+ Encode::Alias->find_alias($_) || lc($_)
+ } ($_[1], $_[2]);
+
+ my $result = ($from eq $to) ? $_[0] : (
+ $decoder{$from, $to} ||= Text::Iconv->new( $from, $to )
+ )->convert($_[0]);
+
+ return $result;
+ }
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Listing.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Listing.pm
new file mode 100644
index 0000000000..c8d72a7185
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Listing.pm
@@ -0,0 +1,435 @@
+package File::Listing;
+
+sub Version { $VERSION; }
+$VERSION = "6.04";
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(parse_dir);
+
+use strict;
+
+use Carp ();
+use HTTP::Date qw(str2time);
+
+
+
+sub parse_dir ($;$$$)
+{
+ my($dir, $tz, $fstype, $error) = @_;
+
+ $fstype ||= 'unix';
+ $fstype = "File::Listing::" . lc $fstype;
+
+ my @args = $_[0];
+ push(@args, $tz) if(@_ >= 2);
+ push(@args, $error) if(@_ >= 4);
+
+ $fstype->parse(@args);
+}
+
+
+sub line { Carp::croak("Not implemented yet"); }
+sub init { } # Dummy sub
+
+
+sub file_mode ($)
+{
+ Carp::croak("Input to file_mode() must be a 10 character string.")
+ unless length($_[0]) == 10;
+
+ # This routine was originally borrowed from Graham Barr's
+ # Net::FTP package.
+
+ local $_ = shift;
+ my $mode = 0;
+ my($type);
+
+ s/^(.)// and $type = $1;
+
+ # When the set-group-ID bit (file mode bit 02000) is set, and the group
+ # execution bit (file mode bit 00020) is unset, and it is a regular file,
+ # some implementations of `ls' use the letter `S', others use `l' or `L'.
+ # Convert this `S'.
+
+ s/[Ll](...)$/S$1/;
+
+ while (/(.)/g) {
+ $mode <<= 1;
+ $mode |= 1 if $1 ne "-" &&
+ $1 ne 'S' &&
+ $1 ne 'T';
+ }
+
+ $mode |= 0004000 if /^..s....../i;
+ $mode |= 0002000 if /^.....s.../i;
+ $mode |= 0001000 if /^........t/i;
+
+ # De facto standard definitions. From 'stat.h' on Solaris 9.
+
+ $type eq "p" and $mode |= 0010000 or # fifo
+ $type eq "c" and $mode |= 0020000 or # character special
+ $type eq "d" and $mode |= 0040000 or # directory
+ $type eq "b" and $mode |= 0060000 or # block special
+ $type eq "-" and $mode |= 0100000 or # regular
+ $type eq "l" and $mode |= 0120000 or # symbolic link
+ $type eq "s" and $mode |= 0140000 or # socket
+ $type eq "D" and $mode |= 0150000 or # door
+ Carp::croak("Unknown file type: $type");
+
+ $mode;
+}
+
+
+sub parse
+{
+ my($pkg, $dir, $tz, $error) = @_;
+
+ # First let's try to determine what kind of dir parameter we have
+ # received. We allow both listings, reference to arrays and
+ # file handles to read from.
+
+ if (ref($dir) eq 'ARRAY') {
+ # Already splitted up
+ }
+ elsif (ref($dir) eq 'GLOB') {
+ # A file handle
+ }
+ elsif (ref($dir)) {
+ Carp::croak("Illegal argument to parse_dir()");
+ }
+ elsif ($dir =~ /^\*\w+(::\w+)+$/) {
+ # This scalar looks like a file handle, so we assume it is
+ }
+ else {
+ # A normal scalar listing
+ $dir = [ split(/\n/, $dir) ];
+ }
+
+ $pkg->init();
+
+ my @files = ();
+ if (ref($dir) eq 'ARRAY') {
+ for (@$dir) {
+ push(@files, $pkg->line($_, $tz, $error));
+ }
+ }
+ else {
+ local($_);
+ while (<$dir>) {
+ chomp;
+ push(@files, $pkg->line($_, $tz, $error));
+ }
+ }
+ wantarray ? @files : \@files;
+}
+
+
+
+package File::Listing::unix;
+
+use HTTP::Date qw(str2time);
+
+# A place to remember current directory from last line parsed.
+use vars qw($curdir @ISA);
+
+@ISA = qw(File::Listing);
+
+
+
+sub init
+{
+ $curdir = '';
+}
+
+
+sub line
+{
+ shift; # package name
+ local($_) = shift;
+ my($tz, $error) = @_;
+
+ s/\015//g;
+ #study;
+
+ my ($kind, $size, $date, $name);
+ if (($kind, $size, $date, $name) =
+ /^([\-FlrwxsStTdD]{10}) # Type and permission bits
+ .* # Graps
+ \D(\d+) # File size
+ \s+ # Some space
+ (\w{3}\s+\d+\s+(?:\d{1,2}:\d{2}|\d{4})|\d{4}-\d{2}-\d{2}\s+\d{2}:\d{2}) # Date
+ \s+ # Some more space
+ (.*)$ # File name
+ /x )
+
+ {
+ return if $name eq '.' || $name eq '..';
+ $name = "$curdir/$name" if length $curdir;
+ my $type = '?';
+ if ($kind =~ /^l/ && $name =~ /(.*) -> (.*)/ ) {
+ $name = $1;
+ $type = "l $2";
+ }
+ elsif ($kind =~ /^[\-F]/) { # (hopefully) a regular file
+ $type = 'f';
+ }
+ elsif ($kind =~ /^[dD]/) {
+ $type = 'd';
+ $size = undef; # Don't believe the reported size
+ }
+ return [$name, $type, $size, str2time($date, $tz),
+ File::Listing::file_mode($kind)];
+
+ }
+ elsif (/^(.+):$/ && !/^[dcbsp].*\s.*\s.*:$/ ) {
+ my $dir = $1;
+ return () if $dir eq '.';
+ $curdir = $dir;
+ return ();
+ }
+ elsif (/^[Tt]otal\s+(\d+)$/ || /^\s*$/) {
+ return ();
+ }
+ elsif (/not found/ || # OSF1, HPUX, and SunOS return
+ # "$file not found"
+ /No such file/ || # IRIX returns
+ # "UX:ls: ERROR: Cannot access $file: No such file or directory"
+ # Solaris returns
+ # "$file: No such file or directory"
+ /cannot find/ # Windows NT returns
+ # "The system cannot find the path specified."
+ ) {
+ return () unless defined $error;
+ &$error($_) if ref($error) eq 'CODE';
+ warn "Error: $_\n" if $error eq 'warn';
+ return ();
+ }
+ elsif ($_ eq '') { # AIX, and Linux return nothing
+ return () unless defined $error;
+ &$error("No such file or directory") if ref($error) eq 'CODE';
+ warn "Warning: No such file or directory\n" if $error eq 'warn';
+ return ();
+ }
+ else {
+ # parse failed, check if the dosftp parse understands it
+ File::Listing::dosftp->init();
+ return(File::Listing::dosftp->line($_,$tz,$error));
+ }
+
+}
+
+
+
+package File::Listing::dosftp;
+
+use HTTP::Date qw(str2time);
+
+# A place to remember current directory from last line parsed.
+use vars qw($curdir @ISA);
+
+@ISA = qw(File::Listing);
+
+
+
+sub init
+{
+ $curdir = '';
+}
+
+
+sub line
+{
+ shift; # package name
+ local($_) = shift;
+ my($tz, $error) = @_;
+
+ s/\015//g;
+
+ my ($date, $size_or_dir, $name, $size);
+
+ # 02-05-96 10:48AM 1415 src.slf
+ # 09-10-96 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
+ \s+ # Some space
+ (<\w{3}>|\d+) # Dir or Size
+ \s+ # Some more space
+ (.+)$ # File name
+ /x )
+ {
+ return if $name eq '.' || $name eq '..';
+ $name = "$curdir/$name" if length $curdir;
+ my $type = '?';
+ if ($size_or_dir eq '<DIR>') {
+ $type = "d";
+ $size = ""; # directories have no size in the pc listing
+ }
+ else {
+ $type = 'f';
+ $size = $size_or_dir;
+ }
+ return [$name, $type, $size, str2time($date, $tz), undef];
+ }
+ else {
+ return () unless defined $error;
+ &$error($_) if ref($error) eq 'CODE';
+ warn "Can't parse: $_\n" if $error eq 'warn';
+ return ();
+ }
+
+}
+
+
+
+package File::Listing::vms;
+@File::Listing::vms::ISA = qw(File::Listing);
+
+package File::Listing::netware;
+@File::Listing::netware::ISA = qw(File::Listing);
+
+
+
+package File::Listing::apache;
+
+use vars qw(@ISA);
+
+@ISA = qw(File::Listing);
+
+
+sub init { }
+
+
+sub line {
+ shift; # package name
+ local($_) = shift;
+ my($tz, $error) = @_; # ignored for now...
+
+ s!</?t[rd][^>]*>! !g; # clean away various table stuff
+ if (m!<A\s+HREF=\"([^\"]+)\">.*</A>.*?(\d+)-([a-zA-Z]+|\d+)-(\d+)\s+(\d+):(\d+)\s+(?:([\d\.]+[kMG]?|-))!i) {
+ my($filename, $filesize) = ($1, $7);
+ my($d,$m,$y, $H,$M) = ($2,$3,$4,$5,$6);
+ if ($m =~ /^\d+$/) {
+ ($d,$y) = ($y,$d) # iso date
+ }
+ else {
+ $m = _monthabbrev_number($m);
+ }
+
+ $filesize = 0 if $filesize eq '-';
+ if ($filesize =~ s/k$//i) {
+ $filesize *= 1024;
+ }
+ elsif ($filesize =~ s/M$//) {
+ $filesize *= 1024*1024;
+ }
+ elsif ($filesize =~ s/G$//) {
+ $filesize *= 1024*1024*1024;
+ }
+ $filesize = int $filesize;
+
+ require Time::Local;
+ my $filetime = Time::Local::timelocal(0,$M,$H,$d,$m-1,_guess_year($y)-1900);
+ my $filetype = ($filename =~ s|/$|| ? "d" : "f");
+ return [$filename, $filetype, $filesize, $filetime, undef];
+ }
+
+ return ();
+}
+
+
+sub _guess_year {
+ my $y = shift;
+ if ($y >= 90) {
+ $y = 1900+$y;
+ }
+ elsif ($y < 100) {
+ $y = 2000+$y;
+ }
+ $y;
+}
+
+
+sub _monthabbrev_number {
+ my $mon = shift;
+ +{'Jan' => 1,
+ 'Feb' => 2,
+ 'Mar' => 3,
+ 'Apr' => 4,
+ 'May' => 5,
+ 'Jun' => 6,
+ 'Jul' => 7,
+ 'Aug' => 8,
+ 'Sep' => 9,
+ 'Oct' => 10,
+ 'Nov' => 11,
+ 'Dec' => 12,
+ }->{$mon};
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+File::Listing - parse directory listing
+
+=head1 SYNOPSIS
+
+ use File::Listing qw(parse_dir);
+ $ENV{LANG} = "C"; # dates in non-English locales not supported
+ for (parse_dir(`ls -l`)) {
+ ($name, $type, $size, $mtime, $mode) = @$_;
+ next if $type ne 'f'; # plain file
+ #...
+ }
+
+ # directory listing can also be read from a file
+ open(LISTING, "zcat ls-lR.gz|");
+ $dir = parse_dir(\*LISTING, '+0000');
+
+=head1 DESCRIPTION
+
+This module exports a single function called parse_dir(), which can be
+used to parse directory listings.
+
+The first parameter to parse_dir() is the directory listing to parse.
+It can be a scalar, a reference to an array of directory lines or a
+glob representing a filehandle to read the directory listing from.
+
+The second parameter is the time zone to use when parsing time stamps
+in the listing. If this value is undefined, then the local time zone is
+assumed.
+
+The third parameter is the type of listing to assume. Currently
+supported formats are 'unix', 'apache' and 'dosftp'. The default
+value is 'unix'. Ideally, the listing type should be determined
+automatically.
+
+The fourth parameter specifies how unparseable lines should be treated.
+Values can be 'ignore', 'warn' or a code reference. Warn means that
+the perl warn() function will be called. If a code reference is
+passed, then this routine will be called and the return value from it
+will be incorporated in the listing. The default is 'ignore'.
+
+Only the first parameter is mandatory.
+
+The return value from parse_dir() is a list of directory entries. In
+a scalar context the return value is a reference to the list. The
+directory entries are represented by an array consisting of [
+$filename, $filetype, $filesize, $filetime, $filemode ]. The
+$filetype value is one of the letters 'f', 'd', 'l' or '?'. The
+$filetime value is the seconds since Jan 1, 1970. The
+$filemode is a bitmask like the mode returned by stat().
+
+=head1 COPYRIGHT
+
+Copyright 1996-2010, Gisle Aas
+
+Based on lsparse.pl (from Lee McLoughlin's ftp mirror package) and
+Net::FTP's parse_dir (Graham Barr).
+
+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/File/Which.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Which.pm
new file mode 100644
index 0000000000..f9fa0be66e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/File/Which.pm
@@ -0,0 +1,392 @@
+package File::Which;
+
+use strict;
+use warnings;
+use Exporter ();
+use File::Spec ();
+
+# ABSTRACT: Perl implementation of the which utility as an API
+our $VERSION = '1.23'; # VERSION
+
+
+our @ISA = 'Exporter';
+our @EXPORT = 'which';
+our @EXPORT_OK = 'where';
+
+use constant IS_VMS => ($^O eq 'VMS');
+use constant IS_MAC => ($^O eq 'MacOS');
+use constant IS_WIN => ($^O eq 'MSWin32' or $^O eq 'dos' or $^O eq 'os2');
+use constant IS_DOS => IS_WIN();
+use constant IS_CYG => ($^O eq 'cygwin' || $^O eq 'msys');
+
+our $IMPLICIT_CURRENT_DIR = IS_WIN || IS_VMS || IS_MAC;
+
+# For Win32 systems, stores the extensions used for
+# executable files
+# For others, the empty string is used
+# because 'perl' . '' eq 'perl' => easier
+my @PATHEXT = ('');
+if ( IS_WIN ) {
+ # WinNT. PATHEXT might be set on Cygwin, but not used.
+ if ( $ENV{PATHEXT} ) {
+ push @PATHEXT, split ';', $ENV{PATHEXT};
+ } else {
+ # Win9X or other: doesn't have PATHEXT, so needs hardcoded.
+ push @PATHEXT, qw{.com .exe .bat};
+ }
+} elsif ( IS_VMS ) {
+ push @PATHEXT, qw{.exe .com};
+} elsif ( IS_CYG ) {
+ # See this for more info
+ # http://cygwin.com/cygwin-ug-net/using-specialnames.html#pathnames-exe
+ push @PATHEXT, qw{.exe .com};
+}
+
+
+sub which {
+ my ($exec) = @_;
+
+ return undef unless defined $exec;
+ return undef if $exec eq '';
+
+ my $all = wantarray;
+ my @results = ();
+
+ # check for aliases first
+ if ( IS_VMS ) {
+ my $symbol = `SHOW SYMBOL $exec`;
+ chomp($symbol);
+ unless ( $? ) {
+ return $symbol unless $all;
+ push @results, $symbol;
+ }
+ }
+ if ( IS_MAC ) {
+ my @aliases = split /\,/, $ENV{Aliases};
+ foreach my $alias ( @aliases ) {
+ # This has not been tested!!
+ # PPT which says MPW-Perl cannot resolve `Alias $alias`,
+ # let's just hope it's fixed
+ if ( lc($alias) eq lc($exec) ) {
+ chomp(my $file = `Alias $alias`);
+ last unless $file; # if it failed, just go on the normal way
+ return $file unless $all;
+ push @results, $file;
+ # we can stop this loop as if it finds more aliases matching,
+ # it'll just be the same result anyway
+ last;
+ }
+ }
+ }
+
+ return $exec
+ if !IS_VMS and !IS_MAC and !IS_WIN and $exec =~ /\// and -f $exec and -x $exec;
+
+ my @path;
+ if($^O eq 'MSWin32') {
+ # File::Spec (at least recent versions)
+ # add the implicit . for you on MSWin32,
+ # but we may or may not want to include
+ # that.
+ @path = split(';', $ENV{PATH});
+ s/"//g for @path;
+ @path = grep length, @path;
+ } else {
+ @path = File::Spec->path;
+ }
+ if ( $IMPLICIT_CURRENT_DIR ) {
+ unshift @path, File::Spec->curdir;
+ }
+
+ foreach my $base ( map { File::Spec->catfile($_, $exec) } @path ) {
+ for my $ext ( @PATHEXT ) {
+ my $file = $base.$ext;
+
+ # We don't want dirs (as they are -x)
+ next if -d $file;
+
+ if (
+ # Executable, normal case
+ -x _
+ or (
+ # MacOS doesn't mark as executable so we check -e
+ IS_MAC
+ ||
+ (
+ ( IS_WIN or IS_CYG )
+ and
+ grep {
+ $file =~ /$_\z/i
+ } @PATHEXT[1..$#PATHEXT]
+ )
+ # DOSish systems don't pass -x on
+ # non-exe/bat/com files. so we check -e.
+ # However, we don't want to pass -e on files
+ # that aren't in PATHEXT, like README.
+ and -e _
+ )
+ ) {
+ return $file unless $all;
+ push @results, $file;
+ }
+ }
+ }
+
+ if ( $all ) {
+ return @results;
+ } else {
+ return undef;
+ }
+}
+
+
+sub where {
+ # force wantarray
+ my @res = which($_[0]);
+ return @res;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+File::Which - Perl implementation of the which utility as an API
+
+=head1 VERSION
+
+version 1.23
+
+=head1 SYNOPSIS
+
+ use File::Which; # exports which()
+ use File::Which qw(which where); # exports which() and where()
+
+ my $exe_path = which 'perldoc';
+
+ my @paths = where 'perl';
+ # Or
+ my @paths = which 'perl'; # an array forces search for all of them
+
+=head1 DESCRIPTION
+
+L<File::Which> finds the full or relative paths to executable programs on
+the system. This is normally the function of C<which> utility. C<which> is
+typically implemented as either a program or a built in shell command. On
+some platforms, such as Microsoft Windows it is not provided as part of the
+core operating system. This module provides a consistent API to this
+functionality regardless of the underlying platform.
+
+The focus of this module is correctness and portability. As a consequence
+platforms where the current directory is implicitly part of the search path
+such as Microsoft Windows will find executables in the current directory,
+whereas on platforms such as UNIX where this is not the case executables
+in the current directory will only be found if the current directory is
+explicitly added to the path.
+
+If you need a portable C<which> on the command line in an environment that
+does not provide it, install L<App::pwhich> which provides a command line
+interface to this API.
+
+=head2 Implementations
+
+L<File::Which> searches the directories of the user's C<PATH> (the current
+implementation uses L<File::Spec#path> to determine the correct C<PATH>),
+looking for executable files having the name specified as a parameter to
+L</which>. Under Win32 systems, which do not have a notion of directly
+executable files, but uses special extensions such as C<.exe> and C<.bat>
+to identify them, C<File::Which> takes extra steps to assure that
+you will find the correct file (so for example, you might be searching for
+C<perl>, it'll try F<perl.exe>, F<perl.bat>, etc.)
+
+=head3 Linux, *BSD and other UNIXes
+
+There should not be any surprises here. The current directory will not be
+searched unless it is explicitly added to the path.
+
+=head3 Modern Windows (including NT, XP, Vista, 7, 8, 10 etc)
+
+Windows NT has a special environment variable called C<PATHEXT>, which is used
+by the shell to look for executable files. Usually, it will contain a list in
+the form C<.EXE;.BAT;.COM;.JS;.VBS> etc. If C<File::Which> finds such an
+environment variable, it parses the list and uses it as the different
+extensions.
+
+=head3 Cygwin
+
+Cygwin provides a Unix-like environment for Microsoft Windows users. In most
+ways it works like other Unix and Unix-like environments, but in a few key
+aspects it works like Windows. As with other Unix environments, the current
+directory is not included in the search unless it is explicitly included in
+the search path. Like on Windows, files with C<.EXE> or <.BAT> extensions will
+be discovered even if they are not part of the query. C<.COM> or extensions
+specified using the C<PATHEXT> environment variable will NOT be discovered
+without the fully qualified name, however.
+
+=head3 Windows ME, 98, 95, MS-DOS, OS/2
+
+This set of operating systems don't have the C<PATHEXT> variable, and usually
+you will find executable files there with the extensions C<.exe>, C<.bat> and
+(less likely) C<.com>. C<File::Which> uses this hardcoded list if it's running
+under Win32 but does not find a C<PATHEXT> variable.
+
+As of 2015 none of these platforms are tested frequently (or perhaps ever),
+but the current maintainer is determined not to intentionally remove support
+for older operating systems.
+
+=head3 VMS
+
+Same case as Windows 9x: uses C<.exe> and C<.com> (in that order).
+
+As of 2015 the current maintainer does not test on VMS, and is in fact not
+certain it has ever been tested on VMS. If this platform is important to you
+and you can help me verify and or support it on that platform please contact
+me.
+
+=head1 FUNCTIONS
+
+=head2 which
+
+ my $path = which $short_exe_name;
+ my @paths = which $short_exe_name;
+
+Exported by default.
+
+C<$short_exe_name> is the name used in the shell to call the program (for
+example, C<perl>).
+
+If it finds an executable with the name you specified, C<which()> will return
+the absolute path leading to this executable (for example, F</usr/bin/perl> or
+F<C:\Perl\Bin\perl.exe>).
+
+If it does I<not> find the executable, it returns C<undef>.
+
+If C<which()> is called in list context, it will return I<all> the
+matches.
+
+=head2 where
+
+ my @paths = where $short_exe_name;
+
+Not exported by default.
+
+Same as L</which> in array context. Similar to the C<where> csh
+built-in command or C<which -a> command for platforms that support the
+C<-a> option. Will return an array containing all the path names
+matching C<$short_exe_name>.
+
+=head1 GLOBALS
+
+=head2 $IMPLICIT_CURRENT_DIR
+
+True if the current directory is included in the search implicitly on
+whatever platform you are using. Normally the default is reasonable,
+but on Windows the current directory is included implicitly for older
+shells like C<cmd.exe> and C<command.com>, but not for newer shells
+like PowerShell. If you overrule this default, you should ALWAYS
+localize the variable to the tightest scope possible, since setting
+this variable from a module can affect other modules. Thus on Windows
+you can get the correct result if the user is running either C<cmd.exe>
+or PowerShell on Windows you can do this:
+
+ use File::Which qw( which );
+ use Shell::Guess;
+
+ my $path = do {
+ my $is_power = Shell::Guess->running_shell->is_power;
+ local $File::Which::IMPLICIT_CURRENT_DIR = !$is_power;
+ which 'foo';
+ };
+
+For a variety of reasons it is difficult to accurately compute the
+shell that a user is using, but L<Shell::Guess> makes a reasonable
+effort.
+
+=head1 CAVEATS
+
+This module has no non-core requirements for Perl 5.6.2 and better.
+
+This module is fully supported back to Perl 5.8.1. It may work on 5.8.0.
+It should work on Perl 5.6.x and I may even test on 5.6.2. I will accept
+patches to maintain compatibility for such older Perls, but you may
+need to fix it on 5.6.x / 5.8.0 and send me a patch.
+
+Not tested on VMS although there is platform specific code
+for those. Anyone who haves a second would be very kind to send me a
+report of how it went.
+
+=head1 SUPPORT
+
+Bugs should be reported via the GitHub issue tracker
+
+L<https://github.com/plicease/File-Which/issues>
+
+For other issues, contact the maintainer.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<pwhich>, L<App::pwhich>
+
+Command line interface to this module.
+
+=item L<IPC::Cmd>
+
+This module provides (among other things) a C<can_run> function, which is
+similar to C<which>. It is a much heavier module since it does a lot more,
+and if you use C<can_run> it pulls in L<ExtUtils::MakeMaker>. This combination
+may be overkill for applications which do not need L<IPC::Cmd>'s complicated
+interface for running programs, or do not need the memory overhead required
+for installing Perl modules.
+
+At least some older versions will find executables in the current directory,
+even if the current directory is not in the search path (which is the default
+on modern Unix).
+
+C<can_run> converts directory path name to the 8.3 version on Windows using
+C<Win32::GetShortPathName> in some cases. This is frequently useful for tools
+that just need to run something using C<system> in scalar mode, but may be
+inconvenient for tools like L<App::pwhich> where user readability is a premium.
+Relying on C<Win32::GetShortPathName> to produce filenames without spaces
+is problematic, as 8.3 filenames can be turned off with tweaks to the
+registry (see L<https://technet.microsoft.com/en-us/library/cc959352.aspx>).
+
+=item L<Devel::CheckBin>
+
+This module purports to "check that a command is available", but does not
+provide any documentation on how you might use it.
+
+=back
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+Per Einar Ellefsen <pereinar@cpan.org>
+
+=item *
+
+Adam Kennedy <adamk@cpan.org>
+
+=item *
+
+Graham Ollis <plicease@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2002 by Per Einar Ellefsen <pereinar@cpan.org>.
+
+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/HTML/Entities.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm
new file mode 100644
index 0000000000..ecd8e0d31f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Entities.pm
@@ -0,0 +1,483 @@
+package HTML::Entities;
+
+=encoding utf8
+
+=head1 NAME
+
+HTML::Entities - Encode or decode strings with HTML entities
+
+=head1 SYNOPSIS
+
+ use HTML::Entities;
+
+ $a = "V&aring;re norske tegn b&oslash;r &#230res";
+ decode_entities($a);
+ encode_entities($a, "\200-\377");
+
+For example, this:
+
+ $input = "vis-à-vis Beyoncé's naïve\npapier-mâché résumé";
+ print encode_entities($input), "\n"
+
+Prints this out:
+
+ vis-&agrave;-vis Beyonc&eacute;'s na&iuml;ve
+ papier-m&acirc;ch&eacute; r&eacute;sum&eacute;
+
+=head1 DESCRIPTION
+
+This module deals with encoding and decoding of strings with HTML
+character entities. The module provides the following functions:
+
+=over 4
+
+=item decode_entities( $string, ... )
+
+This routine replaces HTML entities found in the $string with the
+corresponding Unicode character. Unrecognized entities are left alone.
+
+If multiple strings are provided as argument they are each decoded
+separately and the same number of strings are returned.
+
+If called in void context the arguments are decoded in-place.
+
+This routine is exported by default.
+
+=item _decode_entities( $string, \%entity2char )
+
+=item _decode_entities( $string, \%entity2char, $expand_prefix )
+
+This will in-place replace HTML entities in $string. The %entity2char
+hash must be provided. Named entities not found in the %entity2char
+hash are left alone. Numeric entities are expanded unless their value
+overflow.
+
+The keys in %entity2char are the entity names to be expanded and their
+values are what they should expand into. The values do not have to be
+single character strings. If a key has ";" as suffix,
+then occurrences in $string are only expanded if properly terminated
+with ";". Entities without ";" will be expanded regardless of how
+they are terminated for compatibility with how common browsers treat
+entities in the Latin-1 range.
+
+If $expand_prefix is TRUE then entities without trailing ";" in
+%entity2char will even be expanded as a prefix of a longer
+unrecognized name. The longest matching name in %entity2char will be
+used. This is mainly present for compatibility with an MSIE
+misfeature.
+
+ $string = "foo&nbspbar";
+ _decode_entities($string, { nb => "@", nbsp => "\xA0" }, 1);
+ print $string; # will print "foo bar"
+
+This routine is exported by default.
+
+=item encode_entities( $string )
+
+=item encode_entities( $string, $unsafe_chars )
+
+This routine replaces unsafe characters in $string with their entity
+representation. A second argument can be given to specify which characters to
+consider unsafe. The unsafe characters is specified using the regular
+expression character class syntax (what you find within brackets in regular
+expressions).
+
+The default set of characters to encode are control chars, high-bit chars, and
+the C<< < >>, C<< & >>, C<< > >>, C<< ' >> and C<< " >> characters. But this,
+for example, would encode I<just> the C<< < >>, C<< & >>, C<< > >>, and C<< "
+>> characters:
+
+ $encoded = encode_entities($input, '<>&"');
+
+and this would only encode non-plain ascii:
+
+ $encoded = encode_entities($input, '^\n\x20-\x25\x27-\x7e');
+
+This routine is exported by default.
+
+=item encode_entities_numeric( $string )
+
+=item encode_entities_numeric( $string, $unsafe_chars )
+
+This routine works just like encode_entities, except that the replacement
+entities are always C<&#xI<hexnum>;> and never C<&I<entname>;>. For
+example, C<encode_entities("r\xF4le")> returns "r&ocirc;le", but
+C<encode_entities_numeric("r\xF4le")> returns "r&#xF4;le".
+
+This routine is I<not> exported by default. But you can always
+export it with C<use HTML::Entities qw(encode_entities_numeric);>
+or even C<use HTML::Entities qw(:DEFAULT encode_entities_numeric);>
+
+=back
+
+All these routines modify the string passed as the first argument, if
+called in a void context. In scalar and array contexts, the encoded or
+decoded string is returned (without changing the input string).
+
+If you prefer not to import these routines into your namespace, you can
+call them as:
+
+ use HTML::Entities ();
+ $decoded = HTML::Entities::decode($a);
+ $encoded = HTML::Entities::encode($a);
+ $encoded = HTML::Entities::encode_numeric($a);
+
+The module can also export the %char2entity and the %entity2char
+hashes, which contain the mapping from all characters to the
+corresponding entities (and vice versa, respectively).
+
+=head1 COPYRIGHT
+
+Copyright 1995-2006 Gisle Aas. All rights reserved.
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK $VERSION);
+use vars qw(%entity2char %char2entity);
+
+require 5.004;
+require Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(encode_entities decode_entities _decode_entities);
+@EXPORT_OK = qw(%entity2char %char2entity encode_entities_numeric);
+
+$VERSION = "3.69";
+sub Version { $VERSION; }
+
+require HTML::Parser; # for fast XS implemented decode_entities
+
+
+%entity2char = (
+ # Some normal chars that have special meaning in SGML context
+ amp => '&', # ampersand
+'gt' => '>', # greater than
+'lt' => '<', # less than
+ quot => '"', # double quote
+ apos => "'", # single quote
+
+ # PUBLIC ISO 8879-1986//ENTITIES Added Latin 1//EN//HTML
+ AElig => chr(198), # capital AE diphthong (ligature)
+ Aacute => chr(193), # capital A, acute accent
+ Acirc => chr(194), # capital A, circumflex accent
+ Agrave => chr(192), # capital A, grave accent
+ Aring => chr(197), # capital A, ring
+ Atilde => chr(195), # capital A, tilde
+ Auml => chr(196), # capital A, dieresis or umlaut mark
+ Ccedil => chr(199), # capital C, cedilla
+ ETH => chr(208), # capital Eth, Icelandic
+ Eacute => chr(201), # capital E, acute accent
+ Ecirc => chr(202), # capital E, circumflex accent
+ Egrave => chr(200), # capital E, grave accent
+ Euml => chr(203), # capital E, dieresis or umlaut mark
+ Iacute => chr(205), # capital I, acute accent
+ Icirc => chr(206), # capital I, circumflex accent
+ Igrave => chr(204), # capital I, grave accent
+ Iuml => chr(207), # capital I, dieresis or umlaut mark
+ Ntilde => chr(209), # capital N, tilde
+ Oacute => chr(211), # capital O, acute accent
+ Ocirc => chr(212), # capital O, circumflex accent
+ Ograve => chr(210), # capital O, grave accent
+ Oslash => chr(216), # capital O, slash
+ Otilde => chr(213), # capital O, tilde
+ Ouml => chr(214), # capital O, dieresis or umlaut mark
+ THORN => chr(222), # capital THORN, Icelandic
+ Uacute => chr(218), # capital U, acute accent
+ Ucirc => chr(219), # capital U, circumflex accent
+ Ugrave => chr(217), # capital U, grave accent
+ Uuml => chr(220), # capital U, dieresis or umlaut mark
+ Yacute => chr(221), # capital Y, acute accent
+ aacute => chr(225), # small a, acute accent
+ acirc => chr(226), # small a, circumflex accent
+ aelig => chr(230), # small ae diphthong (ligature)
+ agrave => chr(224), # small a, grave accent
+ aring => chr(229), # small a, ring
+ atilde => chr(227), # small a, tilde
+ auml => chr(228), # small a, dieresis or umlaut mark
+ ccedil => chr(231), # small c, cedilla
+ eacute => chr(233), # small e, acute accent
+ ecirc => chr(234), # small e, circumflex accent
+ egrave => chr(232), # small e, grave accent
+ eth => chr(240), # small eth, Icelandic
+ euml => chr(235), # small e, dieresis or umlaut mark
+ iacute => chr(237), # small i, acute accent
+ icirc => chr(238), # small i, circumflex accent
+ igrave => chr(236), # small i, grave accent
+ iuml => chr(239), # small i, dieresis or umlaut mark
+ ntilde => chr(241), # small n, tilde
+ oacute => chr(243), # small o, acute accent
+ ocirc => chr(244), # small o, circumflex accent
+ ograve => chr(242), # small o, grave accent
+ oslash => chr(248), # small o, slash
+ otilde => chr(245), # small o, tilde
+ ouml => chr(246), # small o, dieresis or umlaut mark
+ szlig => chr(223), # small sharp s, German (sz ligature)
+ thorn => chr(254), # small thorn, Icelandic
+ uacute => chr(250), # small u, acute accent
+ ucirc => chr(251), # small u, circumflex accent
+ ugrave => chr(249), # small u, grave accent
+ uuml => chr(252), # small u, dieresis or umlaut mark
+ yacute => chr(253), # small y, acute accent
+ yuml => chr(255), # small y, dieresis or umlaut mark
+
+ # Some extra Latin 1 chars that are listed in the HTML3.2 draft (21-May-96)
+ copy => chr(169), # copyright sign
+ reg => chr(174), # registered sign
+ nbsp => chr(160), # non breaking space
+
+ # Additional ISO-8859/1 entities listed in rfc1866 (section 14)
+ iexcl => chr(161),
+ cent => chr(162),
+ pound => chr(163),
+ curren => chr(164),
+ yen => chr(165),
+ brvbar => chr(166),
+ sect => chr(167),
+ uml => chr(168),
+ ordf => chr(170),
+ laquo => chr(171),
+'not' => chr(172), # not is a keyword in perl
+ shy => chr(173),
+ macr => chr(175),
+ deg => chr(176),
+ plusmn => chr(177),
+ sup1 => chr(185),
+ sup2 => chr(178),
+ sup3 => chr(179),
+ acute => chr(180),
+ micro => chr(181),
+ para => chr(182),
+ middot => chr(183),
+ cedil => chr(184),
+ ordm => chr(186),
+ raquo => chr(187),
+ frac14 => chr(188),
+ frac12 => chr(189),
+ frac34 => chr(190),
+ iquest => chr(191),
+'times' => chr(215), # times is a keyword in perl
+ divide => chr(247),
+
+ ( $] > 5.007 ? (
+ 'OElig;' => chr(338),
+ 'oelig;' => chr(339),
+ 'Scaron;' => chr(352),
+ 'scaron;' => chr(353),
+ 'Yuml;' => chr(376),
+ 'fnof;' => chr(402),
+ 'circ;' => chr(710),
+ 'tilde;' => chr(732),
+ 'Alpha;' => chr(913),
+ 'Beta;' => chr(914),
+ 'Gamma;' => chr(915),
+ 'Delta;' => chr(916),
+ 'Epsilon;' => chr(917),
+ 'Zeta;' => chr(918),
+ 'Eta;' => chr(919),
+ 'Theta;' => chr(920),
+ 'Iota;' => chr(921),
+ 'Kappa;' => chr(922),
+ 'Lambda;' => chr(923),
+ 'Mu;' => chr(924),
+ 'Nu;' => chr(925),
+ 'Xi;' => chr(926),
+ 'Omicron;' => chr(927),
+ 'Pi;' => chr(928),
+ 'Rho;' => chr(929),
+ 'Sigma;' => chr(931),
+ 'Tau;' => chr(932),
+ 'Upsilon;' => chr(933),
+ 'Phi;' => chr(934),
+ 'Chi;' => chr(935),
+ 'Psi;' => chr(936),
+ 'Omega;' => chr(937),
+ 'alpha;' => chr(945),
+ 'beta;' => chr(946),
+ 'gamma;' => chr(947),
+ 'delta;' => chr(948),
+ 'epsilon;' => chr(949),
+ 'zeta;' => chr(950),
+ 'eta;' => chr(951),
+ 'theta;' => chr(952),
+ 'iota;' => chr(953),
+ 'kappa;' => chr(954),
+ 'lambda;' => chr(955),
+ 'mu;' => chr(956),
+ 'nu;' => chr(957),
+ 'xi;' => chr(958),
+ 'omicron;' => chr(959),
+ 'pi;' => chr(960),
+ 'rho;' => chr(961),
+ 'sigmaf;' => chr(962),
+ 'sigma;' => chr(963),
+ 'tau;' => chr(964),
+ 'upsilon;' => chr(965),
+ 'phi;' => chr(966),
+ 'chi;' => chr(967),
+ 'psi;' => chr(968),
+ 'omega;' => chr(969),
+ 'thetasym;' => chr(977),
+ 'upsih;' => chr(978),
+ 'piv;' => chr(982),
+ 'ensp;' => chr(8194),
+ 'emsp;' => chr(8195),
+ 'thinsp;' => chr(8201),
+ 'zwnj;' => chr(8204),
+ 'zwj;' => chr(8205),
+ 'lrm;' => chr(8206),
+ 'rlm;' => chr(8207),
+ 'ndash;' => chr(8211),
+ 'mdash;' => chr(8212),
+ 'lsquo;' => chr(8216),
+ 'rsquo;' => chr(8217),
+ 'sbquo;' => chr(8218),
+ 'ldquo;' => chr(8220),
+ 'rdquo;' => chr(8221),
+ 'bdquo;' => chr(8222),
+ 'dagger;' => chr(8224),
+ 'Dagger;' => chr(8225),
+ 'bull;' => chr(8226),
+ 'hellip;' => chr(8230),
+ 'permil;' => chr(8240),
+ 'prime;' => chr(8242),
+ 'Prime;' => chr(8243),
+ 'lsaquo;' => chr(8249),
+ 'rsaquo;' => chr(8250),
+ 'oline;' => chr(8254),
+ 'frasl;' => chr(8260),
+ 'euro;' => chr(8364),
+ 'image;' => chr(8465),
+ 'weierp;' => chr(8472),
+ 'real;' => chr(8476),
+ 'trade;' => chr(8482),
+ 'alefsym;' => chr(8501),
+ 'larr;' => chr(8592),
+ 'uarr;' => chr(8593),
+ 'rarr;' => chr(8594),
+ 'darr;' => chr(8595),
+ 'harr;' => chr(8596),
+ 'crarr;' => chr(8629),
+ 'lArr;' => chr(8656),
+ 'uArr;' => chr(8657),
+ 'rArr;' => chr(8658),
+ 'dArr;' => chr(8659),
+ 'hArr;' => chr(8660),
+ 'forall;' => chr(8704),
+ 'part;' => chr(8706),
+ 'exist;' => chr(8707),
+ 'empty;' => chr(8709),
+ 'nabla;' => chr(8711),
+ 'isin;' => chr(8712),
+ 'notin;' => chr(8713),
+ 'ni;' => chr(8715),
+ 'prod;' => chr(8719),
+ 'sum;' => chr(8721),
+ 'minus;' => chr(8722),
+ 'lowast;' => chr(8727),
+ 'radic;' => chr(8730),
+ 'prop;' => chr(8733),
+ 'infin;' => chr(8734),
+ 'ang;' => chr(8736),
+ 'and;' => chr(8743),
+ 'or;' => chr(8744),
+ 'cap;' => chr(8745),
+ 'cup;' => chr(8746),
+ 'int;' => chr(8747),
+ 'there4;' => chr(8756),
+ 'sim;' => chr(8764),
+ 'cong;' => chr(8773),
+ 'asymp;' => chr(8776),
+ 'ne;' => chr(8800),
+ 'equiv;' => chr(8801),
+ 'le;' => chr(8804),
+ 'ge;' => chr(8805),
+ 'sub;' => chr(8834),
+ 'sup;' => chr(8835),
+ 'nsub;' => chr(8836),
+ 'sube;' => chr(8838),
+ 'supe;' => chr(8839),
+ 'oplus;' => chr(8853),
+ 'otimes;' => chr(8855),
+ 'perp;' => chr(8869),
+ 'sdot;' => chr(8901),
+ 'lceil;' => chr(8968),
+ 'rceil;' => chr(8969),
+ 'lfloor;' => chr(8970),
+ 'rfloor;' => chr(8971),
+ 'lang;' => chr(9001),
+ 'rang;' => chr(9002),
+ 'loz;' => chr(9674),
+ 'spades;' => chr(9824),
+ 'clubs;' => chr(9827),
+ 'hearts;' => chr(9829),
+ 'diams;' => chr(9830),
+ ) : ())
+);
+
+
+# Make the opposite mapping
+while (my($entity, $char) = each(%entity2char)) {
+ $entity =~ s/;\z//;
+ $char2entity{$char} = "&$entity;";
+}
+delete $char2entity{"'"}; # only one-way decoding
+
+# Fill in missing entities
+for (0 .. 255) {
+ next if exists $char2entity{chr($_)};
+ $char2entity{chr($_)} = "&#$_;";
+}
+
+my %subst; # compiled encoding regexps
+
+sub encode_entities
+{
+ return undef unless defined $_[0];
+ my $ref;
+ if (defined wantarray) {
+ my $x = $_[0];
+ $ref = \$x; # copy
+ } else {
+ $ref = \$_[0]; # modify in-place
+ }
+ if (defined $_[1] and length $_[1]) {
+ unless (exists $subst{$_[1]}) {
+ # Because we can't compile regex we fake it with a cached sub
+ my $chars = $_[1];
+ $chars =~ s,(?<!\\)([]/]),\\$1,g;
+ $chars =~ s,(?<!\\)\\\z,\\\\,;
+ my $code = "sub {\$_[0] =~ s/([$chars])/\$char2entity{\$1} || num_entity(\$1)/ge; }";
+ $subst{$_[1]} = eval $code;
+ die( $@ . " while trying to turn range: \"$_[1]\"\n "
+ . "into code: $code\n "
+ ) if $@;
+ }
+ &{$subst{$_[1]}}($$ref);
+ } else {
+ # Encode control chars, high bit chars and '<', '&', '>', ''' and '"'
+ $$ref =~ s/([^\n\r\t !\#\$%\(-;=?-~])/$char2entity{$1} || num_entity($1)/ge;
+ }
+ $$ref;
+}
+
+sub encode_entities_numeric {
+ local %char2entity;
+ return &encode_entities; # a goto &encode_entities wouldn't work
+}
+
+
+sub num_entity {
+ sprintf "&#x%X;", ord($_[0]);
+}
+
+# Set up aliases
+*encode = \&encode_entities;
+*encode_numeric = \&encode_entities_numeric;
+*encode_numerically = \&encode_entities_numeric;
+*decode = \&decode_entities;
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm
new file mode 100644
index 0000000000..9230e9a170
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Filter.pm
@@ -0,0 +1,112 @@
+package HTML::Filter;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+require HTML::Parser;
+@ISA=qw(HTML::Parser);
+
+$VERSION = "3.72";
+
+sub declaration { $_[0]->output("<!$_[1]>") }
+sub process { $_[0]->output($_[2]) }
+sub comment { $_[0]->output("<!--$_[1]-->") }
+sub start { $_[0]->output($_[4]) }
+sub end { $_[0]->output($_[2]) }
+sub text { $_[0]->output($_[1]) }
+
+sub output { print $_[1] }
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::Filter - Filter HTML text through the parser
+
+=head1 NOTE
+
+B<This module is deprecated.> The C<HTML::Parser> now provides the
+functionally of C<HTML::Filter> much more efficiently with the
+C<default> handler.
+
+=head1 SYNOPSIS
+
+ require HTML::Filter;
+ $p = HTML::Filter->new->parse_file("index.html");
+
+=head1 DESCRIPTION
+
+C<HTML::Filter> is an HTML parser that by default prints the
+original text of each HTML element (a slow version of cat(1) basically).
+The callback methods may be overridden to modify the filtering for some
+HTML elements and you can override output() method which is called to
+print the HTML text.
+
+C<HTML::Filter> is a subclass of C<HTML::Parser>. This means that
+the document should be given to the parser by calling the $p->parse()
+or $p->parse_file() methods.
+
+=head1 EXAMPLES
+
+The first example is a filter that will remove all comments from an
+HTML file. This is achieved by simply overriding the comment method
+to do nothing.
+
+ package CommentStripper;
+ require HTML::Filter;
+ @ISA=qw(HTML::Filter);
+ sub comment { } # ignore comments
+
+The second example shows a filter that will remove any E<lt>TABLE>s
+found in the HTML file. We specialize the start() and end() methods
+to count table tags and then make output not happen when inside a
+table.
+
+ package TableStripper;
+ require HTML::Filter;
+ @ISA=qw(HTML::Filter);
+ sub start
+ {
+ my $self = shift;
+ $self->{table_seen}++ if $_[0] eq "table";
+ $self->SUPER::start(@_);
+ }
+
+ sub end
+ {
+ my $self = shift;
+ $self->SUPER::end(@_);
+ $self->{table_seen}-- if $_[0] eq "table";
+ }
+
+ sub output
+ {
+ my $self = shift;
+ unless ($self->{table_seen}) {
+ $self->SUPER::output(@_);
+ }
+ }
+
+If you want to collect the parsed text internally you might want to do
+something like this:
+
+ package FilterIntoString;
+ require HTML::Filter;
+ @ISA=qw(HTML::Filter);
+ sub output { push(@{$_[0]->{fhtml}}, $_[1]) }
+ sub filtered_html { join("", @{$_[0]->{fhtml}}) }
+
+=head1 SEE ALSO
+
+L<HTML::Parser>
+
+=head1 COPYRIGHT
+
+Copyright 1997-1999 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/HTML/HeadParser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm
new file mode 100644
index 0000000000..28e9cacc40
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/HeadParser.pm
@@ -0,0 +1,315 @@
+package HTML::HeadParser;
+
+=head1 NAME
+
+HTML::HeadParser - Parse <HEAD> section of a HTML document
+
+=head1 SYNOPSIS
+
+ require HTML::HeadParser;
+ $p = HTML::HeadParser->new;
+ $p->parse($text) and print "not finished";
+
+ $p->header('Title') # to access <title>....</title>
+ $p->header('Content-Base') # to access <base href="http://...">
+ $p->header('Foo') # to access <meta http-equiv="Foo" content="...">
+ $p->header('X-Meta-Author') # to access <meta name="author" content="...">
+ $p->header('X-Meta-Charset') # to access <meta charset="...">
+
+=head1 DESCRIPTION
+
+The C<HTML::HeadParser> is a specialized (and lightweight)
+C<HTML::Parser> that will only parse the E<lt>HEAD>...E<lt>/HEAD>
+section of an HTML document. The parse() method
+will return a FALSE value as soon as some E<lt>BODY> element or body
+text are found, and should not be called again after this.
+
+Note that the C<HTML::HeadParser> might get confused if raw undecoded
+UTF-8 is passed to the parse() method. Make sure the strings are
+properly decoded before passing them on.
+
+The C<HTML::HeadParser> keeps a reference to a header object, and the
+parser will update this header object as the various elements of the
+E<lt>HEAD> section of the HTML document are recognized. The following
+header fields are affected:
+
+=over 4
+
+=item Content-Base:
+
+The I<Content-Base> header is initialized from the E<lt>base
+href="..."> element.
+
+=item Title:
+
+The I<Title> header is initialized from the E<lt>title>...E<lt>/title>
+element.
+
+=item Isindex:
+
+The I<Isindex> header will be added if there is a E<lt>isindex>
+element in the E<lt>head>. The header value is initialized from the
+I<prompt> attribute if it is present. If no I<prompt> attribute is
+given it will have '?' as the value.
+
+=item X-Meta-Foo:
+
+All E<lt>meta> elements containing a C<name> attribute will result in
+headers using the prefix C<X-Meta-> appended with the value of the
+C<name> attribute as the name of the header, and the value of the
+C<content> attribute as the pushed header value.
+
+E<lt>meta> elements containing a C<http-equiv> attribute will result
+in headers as in above, but without the C<X-Meta-> prefix in the
+header name.
+
+E<lt>meta> elements containing a C<charset> attribute will result in
+an C<X-Meta-Charset> header, using the value of the C<charset>
+attribute as the pushed header value.
+
+The ':' character can't be represented in header field names, so
+if the meta element contains this char it's substituted with '-'
+before forming the field name.
+
+=back
+
+=head1 METHODS
+
+The following methods (in addition to those provided by the
+superclass) are available:
+
+=over 4
+
+=cut
+
+
+require HTML::Parser;
+@ISA = qw(HTML::Parser);
+
+use HTML::Entities ();
+
+use strict;
+use vars qw($VERSION $DEBUG);
+#$DEBUG = 1;
+$VERSION = "3.71";
+
+=item $hp = HTML::HeadParser->new
+
+=item $hp = HTML::HeadParser->new( $header )
+
+The object constructor. The optional $header argument should be a
+reference to an object that implement the header() and push_header()
+methods as defined by the C<HTTP::Headers> class. Normally it will be
+of some class that is a or delegates to the C<HTTP::Headers> class.
+
+If no $header is given C<HTML::HeadParser> will create an
+C<HTTP::Headers> object by itself (initially empty).
+
+=cut
+
+sub new
+{
+ my($class, $header) = @_;
+ unless ($header) {
+ require HTTP::Headers;
+ $header = HTTP::Headers->new;
+ }
+
+ my $self = $class->SUPER::new(api_version => 3,
+ start_h => ["start", "self,tagname,attr"],
+ end_h => ["end", "self,tagname"],
+ text_h => ["text", "self,text"],
+ ignore_elements => [qw(script style)],
+ );
+ $self->{'header'} = $header;
+ $self->{'tag'} = ''; # name of active element that takes textual content
+ $self->{'text'} = ''; # the accumulated text associated with the element
+ $self;
+}
+
+=item $hp->header;
+
+Returns a reference to the header object.
+
+=item $hp->header( $key )
+
+Returns a header value. It is just a shorter way to write
+C<$hp-E<gt>header-E<gt>header($key)>.
+
+=cut
+
+sub header
+{
+ my $self = shift;
+ return $self->{'header'} unless @_;
+ $self->{'header'}->header(@_);
+}
+
+sub as_string # legacy
+{
+ my $self = shift;
+ $self->{'header'}->as_string;
+}
+
+sub flush_text # internal
+{
+ my $self = shift;
+ my $tag = $self->{'tag'};
+ my $text = $self->{'text'};
+ $text =~ s/^\s+//;
+ $text =~ s/\s+$//;
+ $text =~ s/\s+/ /g;
+ print "FLUSH $tag => '$text'\n" if $DEBUG;
+ if ($tag eq 'title') {
+ my $decoded;
+ $decoded = utf8::decode($text) if $self->utf8_mode && defined &utf8::decode;
+ HTML::Entities::decode($text);
+ utf8::encode($text) if $decoded;
+ $self->{'header'}->push_header(Title => $text);
+ }
+ $self->{'tag'} = $self->{'text'} = '';
+}
+
+# This is an quote from the HTML3.2 DTD which shows which elements
+# that might be present in a <HEAD>...</HEAD>. Also note that the
+# <HEAD> tags themselves might be missing:
+#
+# <!ENTITY % head.content "TITLE & ISINDEX? & BASE? & STYLE? &
+# SCRIPT* & META* & LINK*">
+#
+# <!ELEMENT HEAD O O (%head.content)>
+#
+# From HTML 4.01:
+#
+# <!ENTITY % head.misc "SCRIPT|STYLE|META|LINK|OBJECT">
+# <!ENTITY % head.content "TITLE & BASE?">
+# <!ELEMENT HEAD O O (%head.content;) +(%head.misc;)>
+#
+# From HTML 5 as of WD-html5-20090825:
+#
+# One or more elements of metadata content, [...]
+# => base, command, link, meta, noscript, script, style, title
+
+sub start
+{
+ my($self, $tag, $attr) = @_; # $attr is reference to a HASH
+ print "START[$tag]\n" if $DEBUG;
+ $self->flush_text if $self->{'tag'};
+ if ($tag eq 'meta') {
+ my $key = $attr->{'http-equiv'};
+ if (!defined($key) || !length($key)) {
+ if ($attr->{name}) {
+ $key = "X-Meta-\u$attr->{name}";
+ } elsif ($attr->{charset}) { # HTML 5 <meta charset="...">
+ $key = "X-Meta-Charset";
+ $self->{header}->push_header($key => $attr->{charset});
+ return;
+ } else {
+ return;
+ }
+ }
+ $key =~ s/:/-/g;
+ $self->{'header'}->push_header($key => $attr->{content});
+ } elsif ($tag eq 'base') {
+ return unless exists $attr->{href};
+ (my $base = $attr->{href}) =~ s/^\s+//; $base =~ s/\s+$//; # HTML5
+ $self->{'header'}->push_header('Content-Base' => $base);
+ } elsif ($tag eq 'isindex') {
+ # This is a non-standard header. Perhaps we should just ignore
+ # this element
+ $self->{'header'}->push_header(Isindex => $attr->{prompt} || '?');
+ } elsif ($tag =~ /^(?:title|noscript|object|command)$/) {
+ # Just remember tag. Initialize header when we see the end tag.
+ $self->{'tag'} = $tag;
+ } elsif ($tag eq 'link') {
+ return unless exists $attr->{href};
+ # <link href="http:..." rel="xxx" rev="xxx" title="xxx">
+ my $href = delete($attr->{href});
+ $href =~ s/^\s+//; $href =~ s/\s+$//; # HTML5
+ my $h_val = "<$href>";
+ for (sort keys %{$attr}) {
+ next if $_ eq "/"; # XHTML junk
+ $h_val .= qq(; $_="$attr->{$_}");
+ }
+ $self->{'header'}->push_header(Link => $h_val);
+ } elsif ($tag eq 'head' || $tag eq 'html') {
+ # ignore
+ } else {
+ # stop parsing
+ $self->eof;
+ }
+}
+
+sub end
+{
+ my($self, $tag) = @_;
+ print "END[$tag]\n" if $DEBUG;
+ $self->flush_text if $self->{'tag'};
+ $self->eof if $tag eq 'head';
+}
+
+sub text
+{
+ my($self, $text) = @_;
+ print "TEXT[$text]\n" if $DEBUG;
+ unless ($self->{first_chunk}) {
+ # drop Unicode BOM if found
+ if ($self->utf8_mode) {
+ $text =~ s/^\xEF\xBB\xBF//;
+ }
+ else {
+ $text =~ s/^\x{FEFF}//;
+ }
+ $self->{first_chunk}++;
+ }
+ my $tag = $self->{tag};
+ if (!$tag && $text =~ /\S/) {
+ # Normal text means start of body
+ $self->eof;
+ return;
+ }
+ return if $tag ne 'title';
+ $self->{'text'} .= $text;
+}
+
+BEGIN {
+ *utf8_mode = sub { 1 } unless HTML::Entities::UNICODE_SUPPORT;
+}
+
+1;
+
+__END__
+
+=back
+
+=head1 EXAMPLE
+
+ $h = HTTP::Headers->new;
+ $p = HTML::HeadParser->new($h);
+ $p->parse(<<EOT);
+ <title>Stupid example</title>
+ <base href="http://www.linpro.no/lwp/">
+ Normal text starts here.
+ EOT
+ undef $p;
+ print $h->title; # should print "Stupid example"
+
+=head1 SEE ALSO
+
+L<HTML::Parser>, L<HTTP::Headers>
+
+The C<HTTP::Headers> class is distributed as part of the
+I<libwww-perl> package. If you don't have that distribution installed
+you need to provide the $header argument to the C<HTML::HeadParser>
+constructor with your own object that implements the documented
+protocol.
+
+=head1 COPYRIGHT
+
+Copyright 1996-2001 Gisle Aas. All rights reserved.
+
+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/HTML/LinkExtor.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm
new file mode 100644
index 0000000000..c2f08c62d9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/LinkExtor.pm
@@ -0,0 +1,185 @@
+package HTML::LinkExtor;
+
+require HTML::Parser;
+@ISA = qw(HTML::Parser);
+$VERSION = "3.69";
+
+=head1 NAME
+
+HTML::LinkExtor - Extract links from an HTML document
+
+=head1 SYNOPSIS
+
+ require HTML::LinkExtor;
+ $p = HTML::LinkExtor->new(\&cb, "http://www.perl.org/");
+ sub cb {
+ my($tag, %links) = @_;
+ print "$tag @{[%links]}\n";
+ }
+ $p->parse_file("index.html");
+
+=head1 DESCRIPTION
+
+I<HTML::LinkExtor> is an HTML parser that extracts links from an
+HTML document. The I<HTML::LinkExtor> is a subclass of
+I<HTML::Parser>. This means that the document should be given to the
+parser by calling the $p->parse() or $p->parse_file() methods.
+
+=cut
+
+use strict;
+use HTML::Tagset ();
+
+# legacy (some applications grabs this hash directly)
+use vars qw(%LINK_ELEMENT);
+*LINK_ELEMENT = \%HTML::Tagset::linkElements;
+
+=over 4
+
+=item $p = HTML::LinkExtor->new
+
+=item $p = HTML::LinkExtor->new( $callback )
+
+=item $p = HTML::LinkExtor->new( $callback, $base )
+
+The constructor takes two optional arguments. The first is a reference
+to a callback routine. It will be called as links are found. If a
+callback is not provided, then links are just accumulated internally
+and can be retrieved by calling the $p->links() method.
+
+The $base argument is an optional base URL used to absolutize all URLs found.
+You need to have the I<URI> module installed if you provide $base.
+
+The callback is called with the lowercase tag name as first argument,
+and then all link attributes as separate key/value pairs. All
+non-link attributes are removed.
+
+=cut
+
+sub new
+{
+ my($class, $cb, $base) = @_;
+ my $self = $class->SUPER::new(
+ start_h => ["_start_tag", "self,tagname,attr"],
+ report_tags => [keys %HTML::Tagset::linkElements],
+ );
+ $self->{extractlink_cb} = $cb;
+ if ($base) {
+ require URI;
+ $self->{extractlink_base} = URI->new($base);
+ }
+ $self;
+}
+
+sub _start_tag
+{
+ my($self, $tag, $attr) = @_;
+
+ my $base = $self->{extractlink_base};
+ my $links = $HTML::Tagset::linkElements{$tag};
+ $links = [$links] unless ref $links;
+
+ my @links;
+ my $a;
+ for $a (@$links) {
+ next unless exists $attr->{$a};
+ (my $link = $attr->{$a}) =~ s/^\s+//; $link =~ s/\s+$//; # HTML5
+ push(@links, $a, $base ? URI->new($link, $base)->abs($base) : $link);
+ }
+ return unless @links;
+ $self->_found_link($tag, @links);
+}
+
+sub _found_link
+{
+ my $self = shift;
+ my $cb = $self->{extractlink_cb};
+ if ($cb) {
+ &$cb(@_);
+ } else {
+ push(@{$self->{'links'}}, [@_]);
+ }
+}
+
+=item $p->links
+
+Returns a list of all links found in the document. The returned
+values will be anonymous arrays with the following elements:
+
+ [$tag, $attr => $url1, $attr2 => $url2,...]
+
+The $p->links method will also truncate the internal link list. This
+means that if the method is called twice without any parsing
+between them the second call will return an empty list.
+
+Also note that $p->links will always be empty if a callback routine
+was provided when the I<HTML::LinkExtor> was created.
+
+=cut
+
+sub links
+{
+ my $self = shift;
+ exists($self->{'links'}) ? @{delete $self->{'links'}} : ();
+}
+
+# We override the parse_file() method so that we can clear the links
+# before we start a new file.
+sub parse_file
+{
+ my $self = shift;
+ delete $self->{'links'};
+ $self->SUPER::parse_file(@_);
+}
+
+=back
+
+=head1 EXAMPLE
+
+This is an example showing how you can extract links from a document
+received using LWP:
+
+ use LWP::UserAgent;
+ use HTML::LinkExtor;
+ use URI::URL;
+
+ $url = "http://www.perl.org/"; # for instance
+ $ua = LWP::UserAgent->new;
+
+ # Set up a callback that collect image links
+ my @imgs = ();
+ sub callback {
+ my($tag, %attr) = @_;
+ return if $tag ne 'img'; # we only look closer at <img ...>
+ push(@imgs, values %attr);
+ }
+
+ # Make the parser. Unfortunately, we don't know the base yet
+ # (it might be different from $url)
+ $p = HTML::LinkExtor->new(\&callback);
+
+ # Request document and parse it as it arrives
+ $res = $ua->request(HTTP::Request->new(GET => $url),
+ sub {$p->parse($_[0])});
+
+ # Expand all image URLs to absolute ones
+ my $base = $res->base;
+ @imgs = map { $_ = url($_, $base)->abs; } @imgs;
+
+ # Print them out
+ print join("\n", @imgs), "\n";
+
+=head1 SEE ALSO
+
+L<HTML::Parser>, L<HTML::Tagset>, L<LWP>, L<URI::URL>
+
+=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.
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm
new file mode 100644
index 0000000000..9c2fc214d5
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Parser.pm
@@ -0,0 +1,1234 @@
+package HTML::Parser;
+
+use strict;
+use vars qw($VERSION @ISA);
+
+$VERSION = "3.72";
+
+require HTML::Entities;
+
+require XSLoader;
+XSLoader::load('HTML::Parser', $VERSION);
+
+sub new
+{
+ my $class = shift;
+ my $self = bless {}, $class;
+ return $self->init(@_);
+}
+
+
+sub init
+{
+ my $self = shift;
+ $self->_alloc_pstate;
+
+ my %arg = @_;
+ my $api_version = delete $arg{api_version} || (@_ ? 3 : 2);
+ if ($api_version >= 4) {
+ require Carp;
+ Carp::croak("API version $api_version not supported " .
+ "by HTML::Parser $VERSION");
+ }
+
+ if ($api_version < 3) {
+ # Set up method callbacks compatible with HTML-Parser-2.xx
+ $self->handler(text => "text", "self,text,is_cdata");
+ $self->handler(end => "end", "self,tagname,text");
+ $self->handler(process => "process", "self,token0,text");
+ $self->handler(start => "start",
+ "self,tagname,attr,attrseq,text");
+
+ $self->handler(comment =>
+ sub {
+ my($self, $tokens) = @_;
+ for (@$tokens) {
+ $self->comment($_);
+ }
+ }, "self,tokens");
+
+ $self->handler(declaration =>
+ sub {
+ my $self = shift;
+ $self->declaration(substr($_[0], 2, -1));
+ }, "self,text");
+ }
+
+ if (my $h = delete $arg{handlers}) {
+ $h = {@$h} if ref($h) eq "ARRAY";
+ while (my($event, $cb) = each %$h) {
+ $self->handler($event => @$cb);
+ }
+ }
+
+ # In the end we try to assume plain attribute or handler
+ while (my($option, $val) = each %arg) {
+ if ($option =~ /^(\w+)_h$/) {
+ $self->handler($1 => @$val);
+ }
+ elsif ($option =~ /^(text|start|end|process|declaration|comment)$/) {
+ require Carp;
+ Carp::croak("Bad constructor option '$option'");
+ }
+ else {
+ $self->$option($val);
+ }
+ }
+
+ return $self;
+}
+
+
+sub parse_file
+{
+ my($self, $file) = @_;
+ my $opened;
+ if (!ref($file) && ref(\$file) ne "GLOB") {
+ # Assume $file is a filename
+ local(*F);
+ open(F, "<", $file) || return undef;
+ binmode(F); # should we? good for byte counts
+ $opened++;
+ $file = *F;
+ }
+ my $chunk = '';
+ while (read($file, $chunk, 512)) {
+ $self->parse($chunk) || last;
+ }
+ close($file) if $opened;
+ $self->eof;
+}
+
+
+sub netscape_buggy_comment # legacy
+{
+ my $self = shift;
+ require Carp;
+ Carp::carp("netscape_buggy_comment() is deprecated. " .
+ "Please use the strict_comment() method instead");
+ my $old = !$self->strict_comment;
+ $self->strict_comment(!shift) if @_;
+ return $old;
+}
+
+# set up method stubs
+sub text { }
+*start = \&text;
+*end = \&text;
+*comment = \&text;
+*declaration = \&text;
+*process = \&text;
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+HTML::Parser - HTML parser class
+
+=head1 SYNOPSIS
+
+ use HTML::Parser ();
+
+ # Create parser object
+ $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);
+ #...
+ $p->eof; # signal end of document
+
+ # Parse directly from file
+ $p->parse_file("foo.html");
+ # or
+ open(my $fh, "<:utf8", "foo.html") || die;
+ $p->parse_file($fh);
+
+=head1 DESCRIPTION
+
+Objects of the C<HTML::Parser> class will recognize markup and
+separate it from plain text (alias data content) in HTML
+documents. As different kinds of markup and text are recognized, the
+corresponding event handlers are invoked.
+
+C<HTML::Parser> is not a generic SGML parser. We have tried to
+make it able to deal with the HTML that is actually "out there", and
+it normally parses as closely as possible to the way the popular web
+browsers do it instead of strictly following one of the many HTML
+specifications from W3C. Where there is disagreement, there is often
+an option that you can enable to get the official behaviour.
+
+The document to be parsed may be supplied in arbitrary chunks. This
+makes on-the-fly parsing as documents are received from the network
+possible.
+
+If event driven parsing does not feel right for your application, you
+might want to use C<HTML::PullParser>. This is an C<HTML::Parser>
+subclass that allows a more conventional program structure.
+
+
+=head1 METHODS
+
+The following method is used to construct a new C<HTML::Parser> object:
+
+=over
+
+=item $p = HTML::Parser->new( %options_and_handlers )
+
+This class method creates a new C<HTML::Parser> object and
+returns it. Key/value argument pairs may be provided to assign event
+handlers or initialize parser options. The handlers and parser
+options can also be set or modified later by the method calls described below.
+
+If a top level key is in the form "<event>_h" (e.g., "text_h") then it
+assigns a handler to that event, otherwise it initializes a parser
+option. The event handler specification value must be an array
+reference. Multiple handlers may also be assigned with the 'handlers
+=> [%handlers]' option. See examples below.
+
+If new() is called without any arguments, it will create a parser that
+uses callback methods compatible with version 2 of C<HTML::Parser>.
+See the section on "version 2 compatibility" below for details.
+
+The special constructor option 'api_version => 2' can be used to
+initialize version 2 callbacks while still setting other options and
+handlers. The 'api_version => 3' option can be used if you don't want
+to set any options and don't want to fall back to v2 compatible
+mode.
+
+Examples:
+
+ $p = HTML::Parser->new(api_version => 3,
+ text_h => [ sub {...}, "dtext" ]);
+
+This creates a new parser object with a text event handler subroutine
+that receives the original text with general entities decoded.
+
+ $p = HTML::Parser->new(api_version => 3,
+ start_h => [ 'my_start', "self,tokens" ]);
+
+This creates a new parser object with a start event handler method
+that receives the $p and the tokens array.
+
+ $p = HTML::Parser->new(api_version => 3,
+ handlers => { text => [\@array, "event,text"],
+ comment => [\@array, "event,text"],
+ });
+
+This creates a new parser object that stores the event type and the
+original text in @array for text and comment events.
+
+=back
+
+The following methods feed the HTML document
+to the C<HTML::Parser> object:
+
+=over
+
+=item $p->parse( $string )
+
+Parse $string as the next chunk of the HTML document. Handlers invoked should
+not attempt to modify the $string in-place until $p->parse returns.
+
+If an invoked event handler aborts parsing by calling $p->eof, then $p->parse()
+will return a FALSE value. Otherwise the return value is a reference to the
+parser object ($p).
+
+=item $p->parse( $code_ref )
+
+If a code reference is passed as the argument to be parsed, then the
+chunks to be parsed are obtained by invoking this function repeatedly.
+Parsing continues until the function returns an empty (or undefined)
+result. When this happens $p->eof is automatically signaled.
+
+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;
+ }
+ $p->parse($chunk) || return undef;
+ }
+
+But it is more efficient as this loop runs internally in XS code.
+
+=item $p->parse_file( $file )
+
+Parse text directly from a file. The $file argument can be a
+filename, an open file handle, or a reference to an open file
+handle.
+
+If $file contains a filename and the file can't be opened, then the
+method returns an undefined value and $! tells why it failed.
+Otherwise the return value is a reference to the parser object.
+
+If a file handle is passed as the $file argument, then the file will
+normally be read until EOF, but not closed.
+
+If an invoked event handler aborts parsing by calling $p->eof,
+then $p->parse_file() may not have read the entire file.
+
+On systems with multi-byte line terminators, the values passed for the
+offset and length argspecs may be too low if parse_file() is called on
+a file handle that is not in binary mode.
+
+If a filename is passed in, then parse_file() will open the file in
+binary mode.
+
+=item $p->eof
+
+Signals the end of the HTML document. Calling the $p->eof method
+outside a handler callback will flush any remaining buffered text
+(which triggers the C<text> event if there is any remaining text).
+
+Calling $p->eof inside a handler will terminate parsing at that point
+and cause $p->parse to return a FALSE value. This also terminates
+parsing by $p->parse_file().
+
+After $p->eof has been called, the parse() and parse_file() methods
+can be invoked to feed new documents with the parser object.
+
+The return value from eof() is a reference to the parser object.
+
+=back
+
+
+Most parser options are controlled by boolean attributes.
+Each boolean attribute is enabled by calling the corresponding method
+with a TRUE argument and disabled with a FALSE argument. The
+attribute value is left unchanged if no argument is given. The return
+value from each method is the old attribute value.
+
+Methods that can be used to get and/or set parser options are:
+
+=over
+
+=item $p->attr_encoded
+
+=item $p->attr_encoded( $bool )
+
+By default, the C<attr> and C<@attr> argspecs will have general
+entities for attribute values decoded. Enabling this attribute leaves
+entities alone.
+
+=item $p->backquote
+
+=item $p->backquote( $bool )
+
+By default, only ' and " are recognized as quote characters around
+attribute values. MSIE also recognizes backquotes for some reason.
+Enabling this attribute provides compatibility with this behaviour.
+
+=item $p->boolean_attribute_value( $val )
+
+This method sets the value reported for boolean attributes inside HTML
+start tags. By default, the name of the attribute is also used as its
+value. This affects the values reported for C<tokens> and C<attr>
+argspecs.
+
+=item $p->case_sensitive
+
+=item $p->case_sensitive( $bool )
+
+By default, tagnames and attribute names are down-cased. Enabling this
+attribute leaves them as found in the HTML source document.
+
+=item $p->closing_plaintext
+
+=item $p->closing_plaintext( $bool )
+
+By default, "plaintext" element can never be closed. Everything up to
+the end of the document is parsed in CDATA mode. This historical
+behaviour is what at least MSIE does. Enabling this attribute makes
+closing "</plaintext>" tag effective and the parsing process will resume
+after seeing this tag. This emulates early gecko-based browsers.
+
+=item $p->empty_element_tags
+
+=item $p->empty_element_tags( $bool )
+
+By default, empty element tags are not recognized as such and the "/"
+before ">" is just treated like a normal name character (unless
+C<strict_names> is enabled). Enabling this attribute make
+C<HTML::Parser> recognize these tags.
+
+Empty element tags look like start tags, but end with the character
+sequence "/>" instead of ">". When recognized by C<HTML::Parser> they
+cause an artificial end event in addition to the start event. The
+C<text> for the artificial end event will be empty and the C<tokenpos>
+array will be undefined even though the token array will have one
+element containing the tag name.
+
+=item $p->marked_sections
+
+=item $p->marked_sections( $bool )
+
+By default, section markings like <![CDATA[...]]> are treated like
+ordinary text. When this attribute is enabled section markings are
+honoured.
+
+There are currently no events associated with the marked section
+markup, but the text can be returned as C<skipped_text>.
+
+=item $p->strict_comment
+
+=item $p->strict_comment( $bool )
+
+By default, comments are terminated by the first occurrence of "-->".
+This is the behaviour of most popular browsers (like Mozilla, Opera and
+MSIE), but it is not correct according to the official HTML
+standard. Officially, you need an even number of "--" tokens before
+the closing ">" is recognized and there may not be anything but
+whitespace between an even and an odd "--".
+
+The official behaviour is enabled by enabling this attribute.
+
+Enabling of 'strict_comment' also disables recognizing these forms as
+comments:
+
+ </ comment>
+ <! comment>
+
+
+=item $p->strict_end
+
+=item $p->strict_end( $bool )
+
+By default, attributes and other junk are allowed to be present on end tags in a
+manner that emulates MSIE's behaviour.
+
+The official behaviour is enabled with this attribute. If enabled,
+only whitespace is allowed between the tagname and the final ">".
+
+=item $p->strict_names
+
+=item $p->strict_names( $bool )
+
+By default, almost anything is allowed in tag and attribute names.
+This is the behaviour of most popular browsers and allows us to parse
+some broken tags with invalid attribute values like:
+
+ <IMG SRC=newprevlstGr.gif ALT=[PREV LIST] BORDER=0>
+
+By default, "LIST]" is parsed as a boolean attribute, not as
+part of the ALT value as was clearly intended. This is also what
+Mozilla sees.
+
+The official behaviour is enabled by enabling this attribute. If
+enabled, it will cause the tag above to be reported as text
+since "LIST]" is not a legal attribute name.
+
+=item $p->unbroken_text
+
+=item $p->unbroken_text( $bool )
+
+By default, blocks of text are given to the text handler as soon as
+possible (but the parser takes care always to break text at a
+boundary between whitespace and non-whitespace so single words and
+entities can always be decoded safely). This might create breaks that
+make it hard to do transformations on the text. When this attribute is
+enabled, blocks of text are always reported in one piece. This will
+delay the text event until the following (non-text) event has been
+recognized by the parser.
+
+Note that the C<offset> argspec will give you the offset of the first
+segment of text and C<length> is the combined length of the segments.
+Since there might be ignored tags in between, these numbers can't be
+used to directly index in the original document file.
+
+=item $p->utf8_mode
+
+=item $p->utf8_mode( $bool )
+
+Enable this option when parsing raw undecoded UTF-8. This tells the
+parser that the entities expanded for strings reported by C<attr>,
+C<@attr> and C<dtext> should be expanded as decoded UTF-8 so they end
+up compatible with the surrounding text.
+
+If C<utf8_mode> is enabled then it is an error to pass strings
+containing characters with code above 255 to the parse() method, and
+the parse() method will croak if you try.
+
+Example: The Unicode character "\x{2665}" is "\xE2\x99\xA5" when UTF-8
+encoded. The character can also be represented by the entity
+"&hearts;" or "&#x2665". If we feed the parser:
+
+ $p->parse("\xE2\x99\xA5&hearts;");
+
+then C<dtext> will be reported as "\xE2\x99\xA5\x{2665}" without
+C<utf8_mode> enabled, but as "\xE2\x99\xA5\xE2\x99\xA5" when enabled.
+The later string is what you want.
+
+This option is only available with perl-5.8 or better.
+
+=item $p->xml_mode
+
+=item $p->xml_mode( $bool )
+
+Enabling this attribute changes the parser to allow some XML
+constructs. This enables the behaviour controlled by individually by
+the C<case_sensitive>, C<empty_element_tags>, C<strict_names> and
+C<xml_pic> attributes and also suppresses special treatment of
+elements that are parsed as CDATA for HTML.
+
+=item $p->xml_pic
+
+=item $p->xml_pic( $bool )
+
+By default, I<processing instructions> are terminated by ">". When
+this attribute is enabled, processing instructions are terminated by
+"?>" instead.
+
+=back
+
+As markup and text is recognized, handlers are invoked. The following
+method is used to set up handlers for different events:
+
+=over
+
+=item $p->handler( event => \&subroutine, $argspec )
+
+=item $p->handler( event => $method_name, $argspec )
+
+=item $p->handler( event => \@accum, $argspec )
+
+=item $p->handler( event => "" );
+
+=item $p->handler( event => undef );
+
+=item $p->handler( event );
+
+This method assigns a subroutine, method, or array to handle an event.
+
+Event is one of C<text>, C<start>, C<end>, C<declaration>, C<comment>,
+C<process>, C<start_document>, C<end_document> or C<default>.
+
+The C<\&subroutine> is a reference to a subroutine which is called to handle
+the event.
+
+The C<$method_name> is the name of a method of $p which is called to handle
+the event.
+
+The C<@accum> is an array that will hold the event information as
+sub-arrays.
+
+If the second argument is "", the event is ignored.
+If it is undef, the default handler is invoked for the event.
+
+The C<$argspec> is a string that describes the information to be reported
+for the event. Any requested information that does not apply to a
+specific event is passed as C<undef>. If argspec is omitted, then it
+is left unchanged.
+
+The return value from $p->handler is the old callback routine or a
+reference to the accumulator array.
+
+Any return values from handler callback routines/methods are always
+ignored. A handler callback can request parsing to be aborted by
+invoking the $p->eof method. A handler callback is not allowed to
+invoke the $p->parse() or $p->parse_file() method. An exception will
+be raised if it tries.
+
+Examples:
+
+ $p->handler(start => "start", 'self, attr, attrseq, text' );
+
+This causes the "start" method of object $p to be called for 'start' events.
+The callback signature is $p->start(\%attr, \@attr_seq, $text).
+
+ $p->handler(start => \&start, 'attr, attrseq, text' );
+
+This causes subroutine start() to be called for 'start' events.
+The callback signature is start(\%attr, \@attr_seq, $text).
+
+ $p->handler(start => \@accum, '"S", attr, attrseq, text' );
+
+This causes 'start' event information to be saved in @accum.
+The array elements will be ['S', \%attr, \@attr_seq, $text].
+
+ $p->handler(start => "");
+
+This causes 'start' events to be ignored. It also suppresses
+invocations of any default handler for start events. It is in most
+cases equivalent to $p->handler(start => sub {}), but is more
+efficient. It is different from the empty-sub-handler in that
+C<skipped_text> is not reset by it.
+
+ $p->handler(start => undef);
+
+This causes no handler to be associated with start events.
+If there is a default handler it will be invoked.
+
+=back
+
+Filters based on tags can be set up to limit the number of events
+reported. The main bottleneck during parsing is often the huge number
+of callbacks made from the parser. Applying filters can improve
+performance significantly.
+
+The following methods control filters:
+
+=over
+
+=item $p->ignore_elements( @tags )
+
+Both the C<start> event and the C<end> event as well as any events that
+would be reported in between are suppressed. The ignored elements can
+contain nested occurrences of itself. Example:
+
+ $p->ignore_elements(qw(script style));
+
+The C<script> and C<style> tags will always nest properly since their
+content is parsed in CDATA mode. For most other tags
+C<ignore_elements> must be used with caution since HTML is often not
+I<well formed>.
+
+=item $p->ignore_tags( @tags )
+
+Any C<start> and C<end> events involving any of the tags given are
+suppressed. To reset the filter (i.e. don't suppress any C<start> and
+C<end> events), call C<ignore_tags> without an argument.
+
+=item $p->report_tags( @tags )
+
+Any C<start> and C<end> events involving any of the tags I<not> given
+are suppressed. To reset the filter (i.e. report all C<start> and
+C<end> events), call C<report_tags> without an argument.
+
+=back
+
+Internally, the system has two filter lists, one for C<report_tags>
+and one for C<ignore_tags>, and both filters are applied. This
+effectively gives C<ignore_tags> precedence over C<report_tags>.
+
+Examples:
+
+ $p->ignore_tags(qw(style));
+ $p->report_tags(qw(script style));
+
+results in only C<script> events being reported.
+
+=head2 Argspec
+
+Argspec is a string containing a comma-separated list that describes
+the information reported by the event. The following argspec
+identifier names can be used:
+
+=over
+
+=item C<attr>
+
+Attr causes a reference to a hash of attribute name/value pairs to be
+passed.
+
+Boolean attributes' values are either the value set by
+$p->boolean_attribute_value, or the attribute name if no value has been
+set by $p->boolean_attribute_value.
+
+This passes undef except for C<start> events.
+
+Unless C<xml_mode> or C<case_sensitive> is enabled, the attribute
+names are forced to lower case.
+
+General entities are decoded in the attribute values and
+one layer of matching quotes enclosing the attribute values is removed.
+
+The Unicode character set is assumed for entity decoding.
+
+=item C<@attr>
+
+Basically the same as C<attr>, but keys and values are passed as
+individual arguments and the original sequence of the attributes is
+kept. The parameters passed will be the same as the @attr calculated
+here:
+
+ @attr = map { $_ => $attr->{$_} } @$attrseq;
+
+assuming $attr and $attrseq here are the hash and array passed as the
+result of C<attr> and C<attrseq> argspecs.
+
+This passes no values for events besides C<start>.
+
+=item C<attrseq>
+
+Attrseq causes a reference to an array of attribute names to be
+passed. This can be useful if you want to walk the C<attr> hash in
+the original sequence.
+
+This passes undef except for C<start> events.
+
+Unless C<xml_mode> or C<case_sensitive> is enabled, the attribute
+names are forced to lower case.
+
+=item C<column>
+
+Column causes the column number of the start of the event to be passed.
+The first column on a line is 0.
+
+=item C<dtext>
+
+Dtext causes the decoded text to be passed. General entities are
+automatically decoded unless the event was inside a CDATA section or
+was between literal start and end tags (C<script>, C<style>,
+C<xmp>, C<iframe>, C<title>, C<textarea> and C<plaintext>).
+
+The Unicode character set is assumed for entity decoding. With Perl
+version 5.6 or earlier only the Latin-1 range is supported, and
+entities for characters outside the range 0..255 are left unchanged.
+
+This passes undef except for C<text> events.
+
+=item C<event>
+
+Event causes the event name to be passed.
+
+The event name is one of C<text>, C<start>, C<end>, C<declaration>,
+C<comment>, C<process>, C<start_document> or C<end_document>.
+
+=item C<is_cdata>
+
+Is_cdata causes a TRUE value to be passed if the event is inside a CDATA
+section or between literal start and end tags (C<script>,
+C<style>, C<xmp>, C<iframe>, C<title>, C<textarea> and C<plaintext>).
+
+if the flag is FALSE for a text event, then you should normally
+either use C<dtext> or decode the entities yourself before the text is
+processed further.
+
+=item C<length>
+
+Length causes the number of bytes of the source text of the event to
+be passed.
+
+=item C<line>
+
+Line causes the line number of the start of the event to be passed.
+The first line in the document is 1. Line counting doesn't start
+until at least one handler requests this value to be reported.
+
+=item C<offset>
+
+Offset causes the byte position in the HTML document of the start of
+the event to be passed. The first byte in the document has offset 0.
+
+=item C<offset_end>
+
+Offset_end causes the byte position in the HTML document of the end of
+the event to be passed. This is the same as C<offset> + C<length>.
+
+=item C<self>
+
+Self causes the current object to be passed to the handler. If the
+handler is a method, this must be the first element in the argspec.
+
+An alternative to passing self as an argspec is to register closures
+that capture $self by themselves as handlers. Unfortunately this
+creates circular references which prevent the HTML::Parser object
+from being garbage collected. Using the C<self> argspec avoids this
+problem.
+
+=item C<skipped_text>
+
+Skipped_text returns the concatenated text of all the events that have
+been skipped since the last time an event was reported. Events might
+be skipped because no handler is registered for them or because some
+filter applies. Skipped text also includes marked section markup,
+since there are no events that can catch it.
+
+If an C<"">-handler is registered for an event, then the text for this
+event is not included in C<skipped_text>. Skipped text both before
+and after the C<"">-event is included in the next reported
+C<skipped_text>.
+
+=item C<tag>
+
+Same as C<tagname>, but prefixed with "/" if it belongs to an C<end>
+event and "!" for a declaration. The C<tag> does not have any prefix
+for C<start> events, and is in this case identical to C<tagname>.
+
+=item C<tagname>
+
+This is the element name (or I<generic identifier> in SGML jargon) for
+start and end tags. Since HTML is case insensitive, this name is
+forced to lower case to ease string matching.
+
+Since XML is case sensitive, the tagname case is not changed when
+C<xml_mode> is enabled. The same happens if the C<case_sensitive> attribute
+is set.
+
+The declaration type of declaration elements is also passed as a tagname,
+even if that is a bit strange.
+In fact, in the current implementation tagname is
+identical to C<token0> except that the name may be forced to lower case.
+
+=item C<token0>
+
+Token0 causes the original text of the first token string to be
+passed. This should always be the same as $tokens->[0].
+
+For C<declaration> events, this is the declaration type.
+
+For C<start> and C<end> events, this is the tag name.
+
+For C<process> and non-strict C<comment> events, this is everything
+inside the tag.
+
+This passes undef if there are no tokens in the event.
+
+=item C<tokenpos>
+
+Tokenpos causes a reference to an array of token positions to be
+passed. For each string that appears in C<tokens>, this array
+contains two numbers. The first number is the offset of the start of
+the token in the original C<text> and the second number is the length
+of the token.
+
+Boolean attributes in a C<start> event will have (0,0) for the
+attribute value offset and length.
+
+This passes undef if there are no tokens in the event (e.g., C<text>)
+and for artificial C<end> events triggered by empty element tags.
+
+If you are using these offsets and lengths to modify C<text>, you
+should either work from right to left, or be very careful to calculate
+the changes to the offsets.
+
+=item C<tokens>
+
+Tokens causes a reference to an array of token strings to be passed.
+The strings are exactly as they were found in the original text,
+no decoding or case changes are applied.
+
+For C<declaration> events, the array contains each word, comment, and
+delimited string starting with the declaration type.
+
+For C<comment> events, this contains each sub-comment. If
+$p->strict_comments is disabled, there will be only one sub-comment.
+
+For C<start> events, this contains the original tag name followed by
+the attribute name/value pairs. The values of boolean attributes will
+be either the value set by $p->boolean_attribute_value, or the
+attribute name if no value has been set by
+$p->boolean_attribute_value.
+
+For C<end> events, this contains the original tag name (always one token).
+
+For C<process> events, this contains the process instructions (always one
+token).
+
+This passes C<undef> for C<text> events.
+
+=item C<text>
+
+Text causes the source text (including markup element delimiters) to be
+passed.
+
+=item C<undef>
+
+Pass an undefined value. Useful as padding where the same handler
+routine is registered for multiple events.
+
+=item C<'...'>
+
+A literal string of 0 to 255 characters enclosed
+in single (') or double (") quotes is passed as entered.
+
+=back
+
+The whole argspec string can be wrapped up in C<'@{...}'> to signal
+that the resulting event array should be flattened. This only makes a
+difference if an array reference is used as the handler target.
+Consider this example:
+
+ $p->handler(text => [], 'text');
+ $p->handler(text => [], '@{text}']);
+
+With two text events; C<"foo">, C<"bar">; then the first example will end
+up with [["foo"], ["bar"]] and the second with ["foo", "bar"] in
+the handler target array.
+
+
+=head2 Events
+
+Handlers for the following events can be registered:
+
+=over
+
+=item C<comment>
+
+This event is triggered when a markup comment is recognized.
+
+Example:
+
+ <!-- This is a comment -- -- So is this -->
+
+=item C<declaration>
+
+This event is triggered when a I<markup declaration> is recognized.
+
+For typical HTML documents, the only declaration you are
+likely to find is <!DOCTYPE ...>.
+
+Example:
+
+ <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
+ "http://www.w3.org/TR/html4/strict.dtd">
+
+DTDs inside <!DOCTYPE ...> will confuse HTML::Parser.
+
+=item C<default>
+
+This event is triggered for events that do not have a specific
+handler. You can set up a handler for this event to catch stuff you
+did not want to catch explicitly.
+
+=item C<end>
+
+This event is triggered when an end tag is recognized.
+
+Example:
+
+ </A>
+
+=item C<end_document>
+
+This event is triggered when $p->eof is called and after any remaining
+text is flushed. There is no document text associated with this event.
+
+=item C<process>
+
+This event is triggered when a processing instructions markup is
+recognized.
+
+The format and content of processing instructions are system and
+application dependent.
+
+Examples:
+
+ <? HTML processing instructions >
+ <? XML processing instructions ?>
+
+=item C<start>
+
+This event is triggered when a start tag is recognized.
+
+Example:
+
+ <A HREF="http://www.perl.com/">
+
+=item C<start_document>
+
+This event is triggered before any other events for a new document. A
+handler for it can be used to initialize stuff. There is no document
+text associated with this event.
+
+=item C<text>
+
+This event is triggered when plain text (characters) is recognized.
+The text may contain multiple lines. A sequence of text may be broken
+between several text events unless $p->unbroken_text is enabled.
+
+The parser will make sure that it does not break a word or a sequence
+of whitespace between two text events.
+
+=back
+
+=head2 Unicode
+
+C<HTML::Parser> can parse Unicode strings when running under
+perl-5.8 or better. If Unicode is passed to $p->parse() then chunks
+of Unicode will be reported to the handlers. The offset and length
+argspecs will also report their position in terms of characters.
+
+It is safe to parse raw undecoded UTF-8 if you either avoid decoding
+entities and make sure to not use I<argspecs> that do, or enable the
+C<utf8_mode> for the parser. Parsing of undecoded UTF-8 might be
+useful when parsing from a file where you need the reported offsets
+and lengths to match the byte offsets in the file.
+
+If a filename is passed to $p->parse_file() then the file will be read
+in binary mode. This will be fine if the file contains only ASCII or
+Latin-1 characters. If the file contains UTF-8 encoded text then care
+must be taken when decoding entities as described in the previous
+paragraph, but better is to open the file with the UTF-8 layer so that
+it is decoded properly:
+
+ open(my $fh, "<:utf8", "index.html") || die "...: $!";
+ $p->parse_file($fh);
+
+If the file contains text encoded in a charset besides ASCII, Latin-1
+or UTF-8 then decoding will always be needed.
+
+=head1 VERSION 2 COMPATIBILITY
+
+When an C<HTML::Parser> object is constructed with no arguments, a set
+of handlers is automatically provided that is compatible with the old
+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");
+
+Setting up these handlers can also be requested with the "api_version =>
+2" constructor option.
+
+=head1 SUBCLASSING
+
+The C<HTML::Parser> class is subclassable. Parser objects are plain
+hashes and C<HTML::Parser> reserves only hash keys that start with
+"_hparser". The parser state can be set up by invoking the init()
+method, which takes the same arguments as new().
+
+=head1 EXAMPLES
+
+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 $!;
+
+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 $!;
+
+This will in most cases be much more efficient since only a single
+callback will be made.
+
+The next example prints out the text that is inside the <title>
+element of an HTML document. Here we start by setting up a start
+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");
+ }
+
+ 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
+found in a document; the program C<htextsub> shows how to edit the text only; the
+program C<hstrip> shows how you can strip out certain tags/elements
+and/or attributes; and the program C<htext> show how to obtain the
+plain text, but not any script/style content.
+
+You can browse the F<eg/> directory online from the I<[Browse]> link on
+the http://search.cpan.org/~gaas/HTML-Parser/ page.
+
+=head1 BUGS
+
+The <style> and <script> sections do not end with the first "</", but
+need the complete corresponding end tag. The standard behaviour is
+not really practical.
+
+When the I<strict_comment> option is enabled, we still recognize
+comments where there is something other than whitespace between even
+and odd "--" markers.
+
+Once $p->boolean_attribute_value has been set, there is no way to
+restore the default behaviour.
+
+There is currently no way to get both quote characters
+into the same literal argspec.
+
+Empty tags, e.g. "<>" and "</>", are not recognized. SGML allows them
+to repeat the previous start tag or close the previous start tag
+respectively.
+
+NET tags, e.g. "code/.../" are not recognized. This is SGML
+shorthand for "<code>...</code>".
+
+Unclosed start or end tags, e.g. "<tt<b>...</b</tt>" are not
+recognized.
+
+=head1 DIAGNOSTICS
+
+The following messages may be produced by HTML::Parser. The notation
+in this listing is the same as used in L<perldiag>:
+
+=over
+
+=item Not a reference to a hash
+
+(F) The object blessed into or subclassed from HTML::Parser is not a
+hash as required by the HTML::Parser methods.
+
+=item Bad signature in parser state object at %p
+
+(F) The _hparser_xs_state element does not refer to a valid state structure.
+Something must have changed the internal value
+stored in this hash element, or the memory has been overwritten.
+
+=item _hparser_xs_state element is not a reference
+
+(F) The _hparser_xs_state element has been destroyed.
+
+=item Can't find '_hparser_xs_state' element in HTML::Parser hash
+
+(F) The _hparser_xs_state element is missing from the parser hash.
+It was either deleted, or not created when the object was created.
+
+=item API version %s not supported by HTML::Parser %s
+
+(F) The constructor option 'api_version' with an argument greater than
+or equal to 4 is reserved for future extensions.
+
+=item Bad constructor option '%s'
+
+(F) An unknown constructor option key was passed to the new() or
+init() methods.
+
+=item Parse loop not allowed
+
+(F) A handler invoked the parse() or parse_file() method.
+This is not permitted.
+
+=item marked sections not supported
+
+(F) The $p->marked_sections() method was invoked in a HTML::Parser
+module that was compiled without support for marked sections.
+
+=item Unknown boolean attribute (%d)
+
+(F) Something is wrong with the internal logic that set up aliases for
+boolean attributes.
+
+=item Only code or array references allowed as handler
+
+(F) The second argument for $p->handler must be either a subroutine
+reference, then name of a subroutine or method, or a reference to an
+array.
+
+=item No handler for %s events
+
+(F) The first argument to $p->handler must be a valid event name; i.e. one
+of "start", "end", "text", "process", "declaration" or "comment".
+
+=item Unrecognized identifier %s in argspec
+
+(F) The identifier is not a known argspec name.
+Use one of the names mentioned in the argspec section above.
+
+=item Literal string is longer than 255 chars in argspec
+
+(F) The current implementation limits the length of literals in
+an argspec to 255 characters. Make the literal shorter.
+
+=item Backslash reserved for literal string in argspec
+
+(F) The backslash character "\" is not allowed in argspec literals.
+It is reserved to permit quoting inside a literal in a later version.
+
+=item Unterminated literal string in argspec
+
+(F) The terminating quote character for a literal was not found.
+
+=item Bad argspec (%s)
+
+(F) Only identifier names, literals, spaces and commas
+are allowed in argspecs.
+
+=item Missing comma separator in argspec
+
+(F) Identifiers in an argspec must be separated with ",".
+
+=item Parsing of undecoded UTF-8 will give garbage when decoding entities
+
+(W) The first chunk parsed appears to contain undecoded UTF-8 and one
+or more argspecs that decode entities are used for the callback
+handlers.
+
+The result of decoding will be a mix of encoded and decoded characters
+for any entities that expand to characters with code above 127. This
+is not a good thing.
+
+The recommended solution is to apply Encode::decode_utf8() on the data before
+feeding it to the $p->parse(). For $p->parse_file() pass a file that has been
+opened in ":utf8" mode.
+
+The alternative solution is to enable the C<utf8_mode> and not decode before
+passing strings to $p->parse(). The parser can process raw undecoded UTF-8
+sanely if the C<utf8_mode> is enabled, or if the "attr", "@attr" or "dtext"
+argspecs are avoided.
+
+=item Parsing string decoded with wrong endianness
+
+(W) The first character in the document is U+FFFE. This is not a
+legal Unicode character but a byte swapped BOM. The result of parsing
+will likely be garbage.
+
+=item Parsing of undecoded UTF-32
+
+(W) The parser found the Unicode UTF-32 BOM signature at the start
+of the document. The result of parsing will likely be garbage.
+
+=item Parsing of undecoded UTF-16
+
+(W) The parser found the Unicode UTF-16 BOM signature at the start of
+the document. The result of parsing will likely be garbage.
+
+=back
+
+=head1 SEE ALSO
+
+L<HTML::Entities>, L<HTML::PullParser>, L<HTML::TokeParser>, L<HTML::HeadParser>,
+L<HTML::LinkExtor>, L<HTML::Form>
+
+L<HTML::TreeBuilder> (part of the I<HTML-Tree> distribution)
+
+L<http://www.w3.org/TR/html4/>
+
+More information about marked sections and processing instructions may
+be found at L<http://www.is-thought.co.uk/book/sgml-8.htm>.
+
+=head1 COPYRIGHT
+
+ Copyright 1996-2016 Gisle Aas. All rights reserved.
+ Copyright 1999-2000 Michael A. Chase. All rights reserved.
+
+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/HTML/PullParser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm
new file mode 100644
index 0000000000..3083379325
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/PullParser.pm
@@ -0,0 +1,209 @@
+package HTML::PullParser;
+
+require HTML::Parser;
+@ISA=qw(HTML::Parser);
+$VERSION = "3.57";
+
+use strict;
+use Carp ();
+
+sub new
+{
+ my($class, %cnf) = @_;
+
+ # Construct argspecs for the various events
+ my %argspec;
+ for (qw(start end text declaration comment process default)) {
+ my $tmp = delete $cnf{$_};
+ next unless defined $tmp;
+ $argspec{$_} = $tmp;
+ }
+ Carp::croak("Info not collected for any events")
+ unless %argspec;
+
+ my $file = delete $cnf{file};
+ my $doc = delete $cnf{doc};
+ Carp::croak("Can't parse from both 'doc' and 'file' at the same time")
+ if defined($file) && defined($doc);
+ Carp::croak("No 'doc' or 'file' given to parse from")
+ unless defined($file) || defined($doc);
+
+ # Create object
+ $cnf{api_version} = 3;
+ my $self = $class->SUPER::new(%cnf);
+
+ my $accum = $self->{pullparser_accum} = [];
+ while (my($event, $argspec) = each %argspec) {
+ $self->SUPER::handler($event => $accum, $argspec);
+ }
+
+ if (defined $doc) {
+ $self->{pullparser_str_ref} = ref($doc) ? $doc : \$doc;
+ $self->{pullparser_str_pos} = 0;
+ }
+ else {
+ if (!ref($file) && ref(\$file) ne "GLOB") {
+ require IO::File;
+ $file = IO::File->new($file, "r") || return;
+ }
+
+ $self->{pullparser_file} = $file;
+ }
+ $self;
+}
+
+
+sub handler
+{
+ Carp::croak("Can't set handlers for HTML::PullParser");
+}
+
+
+sub get_token
+{
+ my $self = shift;
+ while (!@{$self->{pullparser_accum}} && !$self->{pullparser_eof}) {
+ if (my $f = $self->{pullparser_file}) {
+ # must try to parse more from the file
+ my $buf;
+ if (read($f, $buf, 512)) {
+ $self->parse($buf);
+ } else {
+ $self->eof;
+ $self->{pullparser_eof}++;
+ delete $self->{pullparser_file};
+ }
+ }
+ elsif (my $sref = $self->{pullparser_str_ref}) {
+ # must try to parse more from the scalar
+ my $pos = $self->{pullparser_str_pos};
+ my $chunk = substr($$sref, $pos, 512);
+ $self->parse($chunk);
+ $pos += length($chunk);
+ if ($pos < length($$sref)) {
+ $self->{pullparser_str_pos} = $pos;
+ }
+ else {
+ $self->eof;
+ $self->{pullparser_eof}++;
+ delete $self->{pullparser_str_ref};
+ delete $self->{pullparser_str_pos};
+ }
+ }
+ else {
+ die;
+ }
+ }
+ shift @{$self->{pullparser_accum}};
+}
+
+
+sub unget_token
+{
+ my $self = shift;
+ unshift @{$self->{pullparser_accum}}, @_;
+ $self;
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+HTML::PullParser - Alternative HTML::Parser interface
+
+=head1 SYNOPSIS
+
+ use HTML::PullParser;
+
+ $p = HTML::PullParser->new(file => "index.html",
+ start => 'event, tagname, @attr',
+ end => 'event, tagname',
+ ignore_elements => [qw(script style)],
+ ) || die "Can't open: $!";
+ while (my $token = $p->get_token) {
+ #...do something with $token
+ }
+
+=head1 DESCRIPTION
+
+The HTML::PullParser is an alternative interface to the HTML::Parser class.
+It basically turns the HTML::Parser inside out. You associate a file
+(or any IO::Handle object or string) with the parser at construction time and
+then repeatedly call $parser->get_token to obtain the tags and text
+found in the parsed document.
+
+The following methods are provided:
+
+=over 4
+
+=item $p = HTML::PullParser->new( file => $file, %options )
+
+=item $p = HTML::PullParser->new( doc => \$doc, %options )
+
+A C<HTML::PullParser> can be made to parse from either a file or a
+literal document based on whether the C<file> or C<doc> option is
+passed to the parser's constructor.
+
+The C<file> passed in can either be a file name or a file handle
+object. If a file name is passed, and it can't be opened for reading,
+then the constructor will return an undefined value and $! will tell
+you why it failed. Otherwise the argument is taken to be some object
+that the C<HTML::PullParser> can read() from when it needs more data.
+The stream will be read() until EOF, but not closed.
+
+A C<doc> can be passed plain or as a reference
+to a scalar. If a reference is passed then the value of this scalar
+should not be changed before all tokens have been extracted.
+
+Next the information to be returned for the different token types must
+be set up. This is done by simply associating an argspec (as defined
+in L<HTML::Parser>) with the events you have an interest in. For
+instance, if you want C<start> tokens to be reported as the string
+C<'S'> followed by the tagname and the attributes you might pass an
+C<start>-option like this:
+
+ $p = HTML::PullParser->new(
+ doc => $document_to_parse,
+ start => '"S", tagname, @attr',
+ end => '"E", tagname',
+ );
+
+At last other C<HTML::Parser> options, like C<ignore_tags>, and
+C<unbroken_text>, can be passed in. Note that you should not use the
+I<event>_h options to set up parser handlers. That would confuse the
+inner logic of C<HTML::PullParser>.
+
+=item $token = $p->get_token
+
+This method will return the next I<token> found in the HTML document,
+or C<undef> at the end of the document. The token is returned as an
+array reference. The content of this array match the argspec set up
+during C<HTML::PullParser> construction.
+
+=item $p->unget_token( @tokens )
+
+If you find out you have read too many tokens you can push them back,
+so that they are returned again the next time $p->get_token is called.
+
+=back
+
+=head1 EXAMPLES
+
+The 'eg/hform' script shows how we might parse the form section of
+HTML::Documents using HTML::PullParser.
+
+=head1 SEE ALSO
+
+L<HTML::Parser>, L<HTML::TokeParser>
+
+=head1 COPYRIGHT
+
+Copyright 1998-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/HTML/Tagset.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Tagset.pm
new file mode 100644
index 0000000000..754137fd6f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/Tagset.pm
@@ -0,0 +1,471 @@
+package HTML::Tagset;
+
+use strict;
+
+=head1 NAME
+
+HTML::Tagset - data tables useful in parsing HTML
+
+=head1 VERSION
+
+Version 3.20
+
+=cut
+
+use vars qw( $VERSION );
+
+$VERSION = '3.20';
+
+=head1 SYNOPSIS
+
+ use HTML::Tagset;
+ # Then use any of the items in the HTML::Tagset package
+ # as need arises
+
+=head1 DESCRIPTION
+
+This module contains several data tables useful in various kinds of
+HTML parsing operations.
+
+Note that all tag names used are lowercase.
+
+In the following documentation, a "hashset" is a hash being used as a
+set -- the hash conveys that its keys are there, and the actual values
+associated with the keys are not significant. (But what values are
+there, are always true.)
+
+=cut
+
+use vars qw(
+ $VERSION
+ %emptyElement %optionalEndTag %linkElements %boolean_attr
+ %isHeadElement %isBodyElement %isPhraseMarkup
+ %is_Possible_Strict_P_Content
+ %isHeadOrBodyElement
+ %isList %isTableElement %isFormElement
+ %isKnown %canTighten
+ @p_closure_barriers
+ %isCDATA_Parent
+);
+
+=head1 VARIABLES
+
+Note that none of these variables are exported.
+
+=head2 hashset %HTML::Tagset::emptyElement
+
+This hashset has as values the tag-names (GIs) of elements that cannot
+have content. (For example, "base", "br", "hr".) So
+C<$HTML::Tagset::emptyElement{'hr'}> exists and is true.
+C<$HTML::Tagset::emptyElement{'dl'}> does not exist, and so is not true.
+
+=cut
+
+%emptyElement = map {; $_ => 1 } qw(base link meta isindex
+ img br hr wbr
+ input area param
+ embed bgsound spacer
+ basefont col frame
+ ~comment ~literal
+ ~declaration ~pi
+ );
+# The "~"-initial names are for pseudo-elements used by HTML::Entities
+# and TreeBuilder
+
+=head2 hashset %HTML::Tagset::optionalEndTag
+
+This hashset lists tag-names for elements that can have content, but whose
+end-tags are generally, "safely", omissible. Example:
+C<$HTML::Tagset::emptyElement{'li'}> exists and is true.
+
+=cut
+
+%optionalEndTag = map {; $_ => 1 } qw(p li dt dd); # option th tr td);
+
+=head2 hash %HTML::Tagset::linkElements
+
+Values in this hash are tagnames for elements that might contain
+links, and the value for each is a reference to an array of the names
+of attributes whose values can be links.
+
+=cut
+
+%linkElements =
+(
+ 'a' => ['href'],
+ 'applet' => ['archive', 'codebase', 'code'],
+ 'area' => ['href'],
+ 'base' => ['href'],
+ 'bgsound' => ['src'],
+ 'blockquote' => ['cite'],
+ 'body' => ['background'],
+ 'del' => ['cite'],
+ 'embed' => ['pluginspage', 'src'],
+ 'form' => ['action'],
+ 'frame' => ['src', 'longdesc'],
+ 'iframe' => ['src', 'longdesc'],
+ 'ilayer' => ['background'],
+ 'img' => ['src', 'lowsrc', 'longdesc', 'usemap'],
+ 'input' => ['src', 'usemap'],
+ 'ins' => ['cite'],
+ 'isindex' => ['action'],
+ 'head' => ['profile'],
+ 'layer' => ['background', 'src'],
+ 'link' => ['href'],
+ 'object' => ['classid', 'codebase', 'data', 'archive', 'usemap'],
+ 'q' => ['cite'],
+ 'script' => ['src', 'for'],
+ 'table' => ['background'],
+ 'td' => ['background'],
+ 'th' => ['background'],
+ 'tr' => ['background'],
+ 'xmp' => ['href'],
+);
+
+=head2 hash %HTML::Tagset::boolean_attr
+
+This hash (not hashset) lists what attributes of what elements can be
+printed without showing the value (for example, the "noshade" attribute
+of "hr" elements). For elements with only one such attribute, its value
+is simply that attribute name. For elements with many such attributes,
+the value is a reference to a hashset containing all such attributes.
+
+=cut
+
+%boolean_attr = (
+# TODO: make these all hashes
+ 'area' => 'nohref',
+ 'dir' => 'compact',
+ 'dl' => 'compact',
+ 'hr' => 'noshade',
+ 'img' => 'ismap',
+ 'input' => { 'checked' => 1, 'readonly' => 1, 'disabled' => 1 },
+ 'menu' => 'compact',
+ 'ol' => 'compact',
+ 'option' => 'selected',
+ 'select' => 'multiple',
+ 'td' => 'nowrap',
+ 'th' => 'nowrap',
+ 'ul' => 'compact',
+);
+
+#==========================================================================
+# List of all elements from Extensible HTML version 1.0 Transitional DTD:
+#
+# a abbr acronym address applet area b base basefont bdo big
+# blockquote body br button caption center cite code col colgroup
+# dd del dfn dir div dl dt em fieldset font form h1 h2 h3 h4 h5 h6
+# head hr html i iframe img input ins isindex kbd label legend li
+# link map menu meta noframes noscript object ol optgroup option p
+# param pre q s samp script select small span strike strong style
+# sub sup table tbody td textarea tfoot th thead title tr tt u ul
+# var
+#
+# Varia from Mozilla source internal table of tags:
+# Implemented:
+# xmp listing wbr nobr frame frameset noframes ilayer
+# layer nolayer spacer embed multicol
+# But these are unimplemented:
+# sound?? keygen?? server??
+# Also seen here and there:
+# marquee?? app?? (both unimplemented)
+#==========================================================================
+
+=head2 hashset %HTML::Tagset::isPhraseMarkup
+
+This hashset contains all phrasal-level elements.
+
+=cut
+
+%isPhraseMarkup = map {; $_ => 1 } qw(
+ span abbr acronym q sub sup
+ cite code em kbd samp strong var dfn strike
+ b i u s tt small big
+ a img br
+ wbr nobr blink
+ font basefont bdo
+ spacer embed noembed
+); # had: center, hr, table
+
+
+=head2 hashset %HTML::Tagset::is_Possible_Strict_P_Content
+
+This hashset contains all phrasal-level elements that be content of a
+P element, for a strict model of HTML.
+
+=cut
+
+%is_Possible_Strict_P_Content = (
+ %isPhraseMarkup,
+ %isFormElement,
+ map {; $_ => 1} qw( object script map )
+ # I've no idea why there's these latter exceptions.
+ # I'm just following the HTML4.01 DTD.
+);
+
+#from html4 strict:
+#<!ENTITY % fontstyle "TT | I | B | BIG | SMALL">
+#
+#<!ENTITY % phrase "EM | STRONG | DFN | CODE |
+# SAMP | KBD | VAR | CITE | ABBR | ACRONYM" >
+#
+#<!ENTITY % special
+# "A | IMG | OBJECT | BR | SCRIPT | MAP | Q | SUB | SUP | SPAN | BDO">
+#
+#<!ENTITY % formctrl "INPUT | SELECT | TEXTAREA | LABEL | BUTTON">
+#
+#<!-- %inline; covers inline or "text-level" elements -->
+#<!ENTITY % inline "#PCDATA | %fontstyle; | %phrase; | %special; | %formctrl;">
+
+=head2 hashset %HTML::Tagset::isHeadElement
+
+This hashset contains all elements that elements that should be
+present only in the 'head' element of an HTML document.
+
+=cut
+
+%isHeadElement = map {; $_ => 1 }
+ qw(title base link meta isindex script style object bgsound);
+
+=head2 hashset %HTML::Tagset::isList
+
+This hashset contains all elements that can contain "li" elements.
+
+=cut
+
+%isList = map {; $_ => 1 } qw(ul ol dir menu);
+
+=head2 hashset %HTML::Tagset::isTableElement
+
+This hashset contains all elements that are to be found only in/under
+a "table" element.
+
+=cut
+
+%isTableElement = map {; $_ => 1 }
+ qw(tr td th thead tbody tfoot caption col colgroup);
+
+=head2 hashset %HTML::Tagset::isFormElement
+
+This hashset contains all elements that are to be found only in/under
+a "form" element.
+
+=cut
+
+%isFormElement = map {; $_ => 1 }
+ qw(input select option optgroup textarea button label);
+
+=head2 hashset %HTML::Tagset::isBodyMarkup
+
+This hashset contains all elements that are to be found only in/under
+the "body" element of an HTML document.
+
+=cut
+
+%isBodyElement = map {; $_ => 1 } qw(
+ h1 h2 h3 h4 h5 h6
+ p div pre plaintext address blockquote
+ xmp listing
+ center
+
+ multicol
+ iframe ilayer nolayer
+ bgsound
+
+ hr
+ ol ul dir menu li
+ dl dt dd
+ ins del
+
+ fieldset legend
+
+ map area
+ applet param object
+ isindex script noscript
+ table
+ center
+ form
+ ),
+ keys %isFormElement,
+ keys %isPhraseMarkup, # And everything phrasal
+ keys %isTableElement,
+;
+
+
+=head2 hashset %HTML::Tagset::isHeadOrBodyElement
+
+This hashset includes all elements that I notice can fall either in
+the head or in the body.
+
+=cut
+
+%isHeadOrBodyElement = map {; $_ => 1 }
+ qw(script isindex style object map area param noscript bgsound);
+ # i.e., if we find 'script' in the 'body' or the 'head', don't freak out.
+
+
+=head2 hashset %HTML::Tagset::isKnown
+
+This hashset lists all known HTML elements.
+
+=cut
+
+%isKnown = (%isHeadElement, %isBodyElement,
+ map{; $_=>1 }
+ qw( head body html
+ frame frameset noframes
+ ~comment ~pi ~directive ~literal
+));
+ # that should be all known tags ever ever
+
+
+=head2 hashset %HTML::Tagset::canTighten
+
+This hashset lists elements that might have ignorable whitespace as
+children or siblings.
+
+=cut
+
+%canTighten = %isKnown;
+delete @canTighten{
+ keys(%isPhraseMarkup), 'input', 'select',
+ 'xmp', 'listing', 'plaintext', 'pre',
+};
+ # xmp, listing, plaintext, and pre are untightenable, and
+ # in a really special way.
+@canTighten{'hr','br'} = (1,1);
+ # exceptional 'phrasal' things that ARE subject to tightening.
+
+# The one case where I can think of my tightening rules failing is:
+# <p>foo bar<center> <em>baz quux</em> ...
+# ^-- that would get deleted.
+# But that's pretty gruesome code anyhow. You gets what you pays for.
+
+#==========================================================================
+
+=head2 array @HTML::Tagset::p_closure_barriers
+
+This array has a meaning that I have only seen a need for in
+C<HTML::TreeBuilder>, but I include it here on the off chance that someone
+might find it of use:
+
+When we see a "E<lt>pE<gt>" token, we go lookup up the lineage for a p
+element we might have to minimize. At first sight, we might say that
+if there's a p anywhere in the lineage of this new p, it should be
+closed. But that's wrong. Consider this document:
+
+ <html>
+ <head>
+ <title>foo</title>
+ </head>
+ <body>
+ <p>foo
+ <table>
+ <tr>
+ <td>
+ foo
+ <p>bar
+ </td>
+ </tr>
+ </table>
+ </p>
+ </body>
+ </html>
+
+The second p is quite legally inside a much higher p.
+
+My formalization of the reason why this is legal, but this:
+
+ <p>foo<p>bar</p></p>
+
+isn't, is that something about the table constitutes a "barrier" to
+the application of the rule about what p must minimize.
+
+So C<@HTML::Tagset::p_closure_barriers> is the list of all such
+barrier-tags.
+
+=cut
+
+@p_closure_barriers = qw(
+ li blockquote
+ ul ol menu dir
+ dl dt dd
+ td th tr table caption
+ div
+ );
+
+# In an ideal world (i.e., XHTML) we wouldn't have to bother with any of this
+# monkey business of barriers to minimization!
+
+=head2 hashset %isCDATA_Parent
+
+This hashset includes all elements whose content is CDATA.
+
+=cut
+
+%isCDATA_Parent = map {; $_ => 1 }
+ qw(script style xmp listing plaintext);
+
+# TODO: there's nothing else that takes CDATA children, right?
+
+# As the HTML3 DTD (Raggett 1995-04-24) noted:
+# The XMP, LISTING and PLAINTEXT tags are incompatible with SGML
+# and derive from very early versions of HTML. They require non-
+# standard parsers and will cause problems for processing
+# documents with standard SGML tools.
+
+
+=head1 CAVEATS
+
+You may find it useful to alter the behavior of modules (like
+C<HTML::Element> or C<HTML::TreeBuilder>) that use C<HTML::Tagset>'s
+data tables by altering the data tables themselves. You are welcome
+to try, but be careful; and be aware that different modules may or may
+react differently to the data tables being changed.
+
+Note that it may be inappropriate to use these tables for I<producing>
+HTML -- for example, C<%isHeadOrBodyElement> lists the tagnames
+for all elements that can appear either in the head or in the body,
+such as "script". That doesn't mean that I am saying your code that
+produces HTML should feel free to put script elements in either place!
+If you are producing programs that spit out HTML, you should be
+I<intimately> familiar with the DTDs for HTML or XHTML (available at
+C<http://www.w3.org/>), and you should slavishly obey them, not
+the data tables in this document.
+
+=head1 SEE ALSO
+
+L<HTML::Element>, L<HTML::TreeBuilder>, L<HTML::LinkExtor>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 1995-2000 Gisle Aas.
+
+Copyright 2000-2005 Sean M. Burke.
+
+Copyright 2005-2008 Andy Lester.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=head1 ACKNOWLEDGEMENTS
+
+Most of the code/data in this module was adapted from code written
+by Gisle Aas for C<HTML::Element>, C<HTML::TreeBuilder>, and
+C<HTML::LinkExtor>. Then it was maintained by Sean M. Burke.
+
+=head1 AUTHOR
+
+Current maintainer: Andy Lester, C<< <andy at petdance.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-html-tagset at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=HTML-Tagset>. I will
+be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=cut
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm
new file mode 100644
index 0000000000..959b96f6a2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTML/TokeParser.pm
@@ -0,0 +1,371 @@
+package HTML::TokeParser;
+
+require HTML::PullParser;
+@ISA=qw(HTML::PullParser);
+$VERSION = "3.69";
+
+use strict;
+use Carp ();
+use HTML::Entities qw(decode_entities);
+use HTML::Tagset ();
+
+my %ARGS =
+(
+ start => "'S',tagname,attr,attrseq,text",
+ end => "'E',tagname,text",
+ text => "'T',text,is_cdata",
+ process => "'PI',token0,text",
+ comment => "'C',text",
+ declaration => "'D',text",
+
+ # options that default on
+ unbroken_text => 1,
+);
+
+
+sub new
+{
+ my $class = shift;
+ my %cnf;
+
+ if (@_ == 1) {
+ my $type = (ref($_[0]) eq "SCALAR") ? "doc" : "file";
+ %cnf = ($type => $_[0]);
+ }
+ else {
+ unshift @_, (ref($_[0]) eq "SCALAR") ? "doc" : "file" if(scalar(@_) % 2 == 1);
+ %cnf = @_;
+ }
+
+ my $textify = delete $cnf{textify} || {img => "alt", applet => "alt"};
+
+ my $self = $class->SUPER::new(%ARGS, %cnf) || return undef;
+
+ $self->{textify} = $textify;
+ $self;
+}
+
+
+sub get_tag
+{
+ my $self = shift;
+ my $token;
+ while (1) {
+ $token = $self->get_token || return undef;
+ my $type = shift @$token;
+ next unless $type eq "S" || $type eq "E";
+ substr($token->[0], 0, 0) = "/" if $type eq "E";
+ return $token unless @_;
+ for (@_) {
+ return $token if $token->[0] eq $_;
+ }
+ }
+}
+
+
+sub _textify {
+ my($self, $token) = @_;
+ my $tag = $token->[1];
+ return undef unless exists $self->{textify}{$tag};
+
+ my $alt = $self->{textify}{$tag};
+ my $text;
+ if (ref($alt)) {
+ $text = &$alt(@$token);
+ } else {
+ $text = $token->[2]{$alt || "alt"};
+ $text = "[\U$tag]" unless defined $text;
+ }
+ return $text;
+}
+
+
+sub get_text
+{
+ my $self = shift;
+ my @text;
+ while (my $token = $self->get_token) {
+ my $type = $token->[0];
+ if ($type eq "T") {
+ my $text = $token->[1];
+ decode_entities($text) unless $token->[2];
+ push(@text, $text);
+ } elsif ($type =~ /^[SE]$/) {
+ my $tag = $token->[1];
+ if ($type eq "S") {
+ if (defined(my $text = _textify($self, $token))) {
+ push(@text, $text);
+ next;
+ }
+ } else {
+ $tag = "/$tag";
+ }
+ if (!@_ || grep $_ eq $tag, @_) {
+ $self->unget_token($token);
+ last;
+ }
+ push(@text, " ")
+ if $tag eq "br" || !$HTML::Tagset::isPhraseMarkup{$token->[1]};
+ }
+ }
+ join("", @text);
+}
+
+
+sub get_trimmed_text
+{
+ my $self = shift;
+ my $text = $self->get_text(@_);
+ $text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
+ $text;
+}
+
+sub get_phrase {
+ my $self = shift;
+ my @text;
+ while (my $token = $self->get_token) {
+ my $type = $token->[0];
+ if ($type eq "T") {
+ my $text = $token->[1];
+ decode_entities($text) unless $token->[2];
+ push(@text, $text);
+ } elsif ($type =~ /^[SE]$/) {
+ my $tag = $token->[1];
+ if ($type eq "S") {
+ if (defined(my $text = _textify($self, $token))) {
+ push(@text, $text);
+ next;
+ }
+ }
+ if (!$HTML::Tagset::isPhraseMarkup{$tag}) {
+ $self->unget_token($token);
+ last;
+ }
+ push(@text, " ") if $tag eq "br";
+ }
+ }
+ my $text = join("", @text);
+ $text =~ s/^\s+//; $text =~ s/\s+$//; $text =~ s/\s+/ /g;
+ $text;
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+HTML::TokeParser - Alternative HTML::Parser interface
+
+=head1 SYNOPSIS
+
+ require HTML::TokeParser;
+ $p = HTML::TokeParser->new("index.html") ||
+ die "Can't open: $!";
+ $p->empty_element_tags(1); # configure its behaviour
+
+ while (my $token = $p->get_token) {
+ #...
+ }
+
+=head1 DESCRIPTION
+
+The C<HTML::TokeParser> is an alternative interface to the
+C<HTML::Parser> class. It is an C<HTML::PullParser> subclass with a
+predeclared set of token types. If you wish the tokens to be reported
+differently you probably want to use the C<HTML::PullParser> directly.
+
+The following methods are available:
+
+=over 4
+
+=item $p = HTML::TokeParser->new( $filename, %opt );
+
+=item $p = HTML::TokeParser->new( $filehandle, %opt );
+
+=item $p = HTML::TokeParser->new( \$document, %opt );
+
+The object constructor argument is either a file name, a file handle
+object, or the complete document to be parsed. Extra options can be
+provided as key/value pairs and are processed as documented by the base
+classes.
+
+If the argument is a plain scalar, then it is taken as the name of a
+file to be opened and parsed. If the file can't be opened for
+reading, then the constructor will return C<undef> and $! will tell
+you why it failed.
+
+If the argument is a reference to a plain scalar, then this scalar is
+taken to be the literal document to parse. The value of this
+scalar should not be changed before all tokens have been extracted.
+
+Otherwise the argument is taken to be some object that the
+C<HTML::TokeParser> can read() from when it needs more data. Typically
+it will be a filehandle of some kind. The stream will be read() until
+EOF, but not closed.
+
+A newly constructed C<HTML::TokeParser> differ from its base classes
+by having the C<unbroken_text> attribute enabled by default. See
+L<HTML::Parser> for a description of this and other attributes that
+influence how the document is parsed. It is often a good idea to enable
+C<empty_element_tags> behaviour.
+
+Note that the parsing result will likely not be valid if raw undecoded
+UTF-8 is used as a source. When parsing UTF-8 encoded files turn
+on UTF-8 decoding:
+
+ open(my $fh, "<:utf8", "index.html") || die "Can't open 'index.html': $!";
+ my $p = HTML::TokeParser->new( $fh );
+ # ...
+
+If a $filename is passed to the constructor the file will be opened in
+raw mode and the parsing result will only be valid if its content is
+Latin-1 or pure ASCII.
+
+If parsing from an UTF-8 encoded string buffer decode it first:
+
+ utf8::decode($document);
+ my $p = HTML::TokeParser->new( \$document );
+ # ...
+
+=item $p->get_token
+
+This method will return the next I<token> found in the HTML document,
+or C<undef> at the end of the document. The token is returned as an
+array reference. The first element of the array will be a string
+denoting the type of this token: "S" for start tag, "E" for end tag,
+"T" for text, "C" for comment, "D" for declaration, and "PI" for
+process instructions. The rest of the token array depend on the type
+like this:
+
+ ["S", $tag, $attr, $attrseq, $text]
+ ["E", $tag, $text]
+ ["T", $text, $is_data]
+ ["C", $text]
+ ["D", $text]
+ ["PI", $token0, $text]
+
+where $attr is a hash reference, $attrseq is an array reference and
+the rest are plain scalars. The L<HTML::Parser/Argspec> explains the
+details.
+
+=item $p->unget_token( @tokens )
+
+If you find you have read too many tokens you can push them back,
+so that they are returned the next time $p->get_token is called.
+
+=item $p->get_tag
+
+=item $p->get_tag( @tags )
+
+This method returns the next start or end tag (skipping any other
+tokens), or C<undef> if there are no more tags in the document. If
+one or more arguments are given, then we skip tokens until one of the
+specified tag types is found. For example:
+
+ $p->get_tag("font", "/font");
+
+will find the next start or end tag for a font-element.
+
+The tag information is returned as an array reference in the same form
+as for $p->get_token above, but the type code (first element) is
+missing. A start tag will be returned like this:
+
+ [$tag, $attr, $attrseq, $text]
+
+The tagname of end tags are prefixed with "/", i.e. end tag is
+returned like this:
+
+ ["/$tag", $text]
+
+=item $p->get_text
+
+=item $p->get_text( @endtags )
+
+This method returns all text found at the current position. It will
+return a zero length string if the next token is not text. Any
+entities will be converted to their corresponding character.
+
+If one or more arguments are given, then we return all text occurring
+before the first of the specified tags found. For example:
+
+ $p->get_text("p", "br");
+
+will return the text up to either a paragraph of linebreak element.
+
+The text might span tags that should be I<textified>. This is
+controlled by the $p->{textify} attribute, which is a hash that
+defines how certain tags can be treated as text. If the name of a
+start tag matches a key in this hash then this tag is converted to
+text. The hash value is used to specify which tag attribute to obtain
+the text from. If this tag attribute is missing, then the upper case
+name of the tag enclosed in brackets is returned, e.g. "[IMG]". The
+hash value can also be a subroutine reference. In this case the
+routine is called with the start tag token content as its argument and
+the return value is treated as the text.
+
+The default $p->{textify} value is:
+
+ {img => "alt", applet => "alt"}
+
+This means that <IMG> and <APPLET> tags are treated as text, and that
+the text to substitute can be found in the ALT attribute.
+
+=item $p->get_trimmed_text
+
+=item $p->get_trimmed_text( @endtags )
+
+Same as $p->get_text above, but will collapse any sequences of white
+space to a single space character. Leading and trailing white space is
+removed.
+
+=item $p->get_phrase
+
+This will return all text found at the current position ignoring any
+phrasal-level tags. Text is extracted until the first non
+phrasal-level tag. Textification of tags is the same as for
+get_text(). This method will collapse white space in the same way as
+get_trimmed_text() does.
+
+The definition of <i>phrasal-level tags</i> is obtained from the
+HTML::Tagset module.
+
+=back
+
+=head1 EXAMPLES
+
+This example extracts all links from a document. It will print one
+line for each link, containing the URL and the textual description
+between the <A>...</A> tags:
+
+ use HTML::TokeParser;
+ $p = HTML::TokeParser->new(shift||"index.html");
+
+ while (my $token = $p->get_tag("a")) {
+ my $url = $token->[1]{href} || "-";
+ my $text = $p->get_trimmed_text("/a");
+ print "$url\t$text\n";
+ }
+
+This example extract the <TITLE> from the document:
+
+ use HTML::TokeParser;
+ $p = HTML::TokeParser->new(shift||"index.html");
+ if ($p->get_tag("title")) {
+ my $title = $p->get_trimmed_text;
+ print "Title: $title\n";
+ }
+
+=head1 SEE ALSO
+
+L<HTML::PullParser>, L<HTML::Parser>
+
+=head1 COPYRIGHT
+
+Copyright 1998-2005 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/HTTP/Config.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Config.pm
new file mode 100644
index 0000000000..0742c932fc
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Config.pm
@@ -0,0 +1,454 @@
+package HTTP::Config;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+use URI;
+
+sub new {
+ my $class = shift;
+ return bless [], $class;
+}
+
+sub entries {
+ my $self = shift;
+ @$self;
+}
+
+sub empty {
+ my $self = shift;
+ not @$self;
+}
+
+sub add {
+ if (@_ == 2) {
+ my $self = shift;
+ push(@$self, shift);
+ return;
+ }
+ my($self, %spec) = @_;
+ push(@$self, \%spec);
+ return;
+}
+
+sub find2 {
+ my($self, %spec) = @_;
+ my @found;
+ my @rest;
+ ITEM:
+ for my $item (@$self) {
+ for my $k (keys %spec) {
+ no warnings 'uninitialized';
+ if (!exists $item->{$k} || $spec{$k} ne $item->{$k}) {
+ push(@rest, $item);
+ next ITEM;
+ }
+ }
+ push(@found, $item);
+ }
+ return \@found unless wantarray;
+ return \@found, \@rest;
+}
+
+sub find {
+ my $self = shift;
+ my $f = $self->find2(@_);
+ return @$f if wantarray;
+ return $f->[0];
+}
+
+sub remove {
+ my($self, %spec) = @_;
+ my($removed, $rest) = $self->find2(%spec);
+ @$self = @$rest if @$removed;
+ return @$removed;
+}
+
+my %MATCH = (
+ m_scheme => sub {
+ my($v, $uri) = @_;
+ return $uri->_scheme eq $v; # URI known to be canonical
+ },
+ m_secure => sub {
+ my($v, $uri) = @_;
+ my $secure = $uri->can("secure") ? $uri->secure : $uri->_scheme eq "https";
+ return $secure == !!$v;
+ },
+ m_host_port => sub {
+ my($v, $uri) = @_;
+ return unless $uri->can("host_port");
+ return $uri->host_port eq $v, 7;
+ },
+ m_host => sub {
+ my($v, $uri) = @_;
+ return unless $uri->can("host");
+ return $uri->host eq $v, 6;
+ },
+ m_port => sub {
+ my($v, $uri) = @_;
+ return unless $uri->can("port");
+ return $uri->port eq $v;
+ },
+ m_domain => sub {
+ my($v, $uri) = @_;
+ return unless $uri->can("host");
+ my $h = $uri->host;
+ $h = "$h.local" unless $h =~ /\./;
+ $v = ".$v" unless $v =~ /^\./;
+ return length($v), 5 if substr($h, -length($v)) eq $v;
+ return 0;
+ },
+ m_path => sub {
+ my($v, $uri) = @_;
+ return unless $uri->can("path");
+ return $uri->path eq $v, 4;
+ },
+ m_path_prefix => sub {
+ my($v, $uri) = @_;
+ return unless $uri->can("path");
+ my $path = $uri->path;
+ my $len = length($v);
+ return $len, 3 if $path eq $v;
+ return 0 if length($path) <= $len;
+ $v .= "/" unless $v =~ m,/\z,,;
+ return $len, 3 if substr($path, 0, length($v)) eq $v;
+ return 0;
+ },
+ m_path_match => sub {
+ my($v, $uri) = @_;
+ return unless $uri->can("path");
+ return $uri->path =~ $v;
+ },
+ m_uri__ => sub {
+ my($v, $k, $uri) = @_;
+ return unless $uri->can($k);
+ return 1 unless defined $v;
+ return $uri->$k eq $v;
+ },
+ m_method => sub {
+ my($v, $uri, $request) = @_;
+ return $request && $request->method eq $v;
+ },
+ m_proxy => sub {
+ my($v, $uri, $request) = @_;
+ return $request && ($request->{proxy} || "") eq $v;
+ },
+ m_code => sub {
+ my($v, $uri, $request, $response) = @_;
+ $v =~ s/xx\z//;
+ return unless $response;
+ return length($v), 2 if substr($response->code, 0, length($v)) eq $v;
+ },
+ m_media_type => sub { # for request too??
+ my($v, $uri, $request, $response) = @_;
+ return unless $response;
+ return 1, 1 if $v eq "*/*";
+ my $ct = $response->content_type;
+ return 2, 1 if $v =~ s,/\*\z,, && $ct =~ m,^\Q$v\E/,;
+ return 3, 1 if $v eq "html" && $response->content_is_html;
+ return 4, 1 if $v eq "xhtml" && $response->content_is_xhtml;
+ return 10, 1 if $v eq $ct;
+ return 0;
+ },
+ m_header__ => sub {
+ my($v, $k, $uri, $request, $response) = @_;
+ return unless $request;
+ return 1 if $request->header($k) eq $v;
+ return 1 if $response && $response->header($k) eq $v;
+ return 0;
+ },
+ m_response_attr__ => sub {
+ my($v, $k, $uri, $request, $response) = @_;
+ return unless $response;
+ return 1 if !defined($v) && exists $response->{$k};
+ return 0 unless exists $response->{$k};
+ return 1 if $response->{$k} eq $v;
+ return 0;
+ },
+);
+
+sub matching {
+ my $self = shift;
+ if (@_ == 1) {
+ if ($_[0]->can("request")) {
+ unshift(@_, $_[0]->request);
+ unshift(@_, undef) unless defined $_[0];
+ }
+ unshift(@_, $_[0]->uri_canonical) if $_[0] && $_[0]->can("uri_canonical");
+ }
+ my($uri, $request, $response) = @_;
+ $uri = URI->new($uri) unless ref($uri);
+
+ my @m;
+ ITEM:
+ for my $item (@$self) {
+ my $order;
+ for my $ikey (keys %$item) {
+ my $mkey = $ikey;
+ my $k;
+ $k = $1 if $mkey =~ s/__(.*)/__/;
+ if (my $m = $MATCH{$mkey}) {
+ #print "$ikey $mkey\n";
+ my($c, $o);
+ my @arg = (
+ defined($k) ? $k : (),
+ $uri, $request, $response
+ );
+ my $v = $item->{$ikey};
+ $v = [$v] unless ref($v) eq "ARRAY";
+ for (@$v) {
+ ($c, $o) = $m->($_, @arg);
+ #print " - $_ ==> $c $o\n";
+ last if $c;
+ }
+ next ITEM unless $c;
+ $order->[$o || 0] += $c;
+ }
+ }
+ $order->[7] ||= 0;
+ $item->{_order} = join(".", reverse map sprintf("%03d", $_ || 0), @$order);
+ push(@m, $item);
+ }
+ @m = sort { $b->{_order} cmp $a->{_order} } @m;
+ delete $_->{_order} for @m;
+ return @m if wantarray;
+ return $m[0];
+}
+
+sub add_item {
+ my $self = shift;
+ my $item = shift;
+ return $self->add(item => $item, @_);
+}
+
+sub remove_items {
+ my $self = shift;
+ return map $_->{item}, $self->remove(@_);
+}
+
+sub matching_items {
+ my $self = shift;
+ return map $_->{item}, $self->matching(@_);
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Config - Configuration for request and response objects
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ use HTTP::Config;
+ my $c = HTTP::Config->new;
+ $c->add(m_domain => ".example.com", m_scheme => "http", verbose => 1);
+
+ use HTTP::Request;
+ my $request = HTTP::Request->new(GET => "http://www.example.com");
+
+ if (my @m = $c->matching($request)) {
+ print "Yadayada\n" if $m[0]->{verbose};
+ }
+
+=head1 DESCRIPTION
+
+An C<HTTP::Config> object is a list of entries that
+can be matched against request or request/response pairs. Its
+purpose is to hold configuration data that can be looked up given a
+request or response object.
+
+Each configuration entry is a hash. Some keys specify matching to
+occur against attributes of request/response objects. Other keys can
+be used to hold user data.
+
+The following methods are provided:
+
+=over 4
+
+=item $conf = HTTP::Config->new
+
+Constructs a new empty C<HTTP::Config> object and returns it.
+
+=item $conf->entries
+
+Returns the list of entries in the configuration object.
+In scalar context returns the number of entries.
+
+=item $conf->empty
+
+Return true if there are no entries in the configuration object.
+This is just a shorthand for C<< not $conf->entries >>.
+
+=item $conf->add( %matchspec, %other )
+
+=item $conf->add( \%entry )
+
+Adds a new entry to the configuration.
+You can either pass separate key/value pairs or a hash reference.
+
+=item $conf->remove( %spec )
+
+Removes (and returns) the entries that have matches for all the key/value pairs in %spec.
+If %spec is empty this will match all entries; so it will empty the configuration object.
+
+=item $conf->matching( $uri, $request, $response )
+
+=item $conf->matching( $uri )
+
+=item $conf->matching( $request )
+
+=item $conf->matching( $response )
+
+Returns the entries that match the given $uri, $request and $response triplet.
+
+If called with a single $request object then the $uri is obtained by calling its 'uri_canonical' method.
+If called with a single $response object, then the request object is obtained by calling its 'request' method;
+and then the $uri is obtained as if a single $request was provided.
+
+The entries are returned with the most specific matches first.
+In scalar context returns the most specific match or C<undef> in none match.
+
+=item $conf->add_item( $item, %matchspec )
+
+=item $conf->remove_items( %spec )
+
+=item $conf->matching_items( $uri, $request, $response )
+
+Wrappers that hides the entries themselves.
+
+=back
+
+=head2 Matching
+
+The following keys on a configuration entry specify matching. For all
+of these you can provide an array of values instead of a single value.
+The entry matches if at least one of the values in the array matches.
+
+Entries that require match against a response object attribute will never match
+unless a response object was provided.
+
+=over
+
+=item m_scheme => $scheme
+
+Matches if the URI uses the specified scheme; e.g. "http".
+
+=item m_secure => $bool
+
+If $bool is TRUE; matches if the URI uses a secure scheme. If $bool
+is FALSE; matches if the URI does not use a secure scheme. An example
+of a secure scheme is "https".
+
+=item m_host_port => "$hostname:$port"
+
+Matches if the URI's host_port method return the specified value.
+
+=item m_host => $hostname
+
+Matches if the URI's host method returns the specified value.
+
+=item m_port => $port
+
+Matches if the URI's port method returns the specified value.
+
+=item m_domain => ".$domain"
+
+Matches if the URI's host method return a value that within the given
+domain. The hostname "www.example.com" will for instance match the
+domain ".com".
+
+=item m_path => $path
+
+Matches if the URI's path method returns the specified value.
+
+=item m_path_prefix => $path
+
+Matches if the URI's path is the specified path or has the specified
+path as prefix.
+
+=item m_path_match => $Regexp
+
+Matches if the regular expression matches the URI's path. Eg. qr/\.html$/.
+
+=item m_method => $method
+
+Matches if the request method matches the specified value. Eg. "GET" or "POST".
+
+=item m_code => $digit
+
+=item m_code => $status_code
+
+Matches if the response status code matches. If a single digit is
+specified; matches for all response status codes beginning with that digit.
+
+=item m_proxy => $url
+
+Matches if the request is to be sent to the given Proxy server.
+
+=item m_media_type => "*/*"
+
+=item m_media_type => "text/*"
+
+=item m_media_type => "html"
+
+=item m_media_type => "xhtml"
+
+=item m_media_type => "text/html"
+
+Matches if the response media type matches.
+
+With a value of "html" matches if $response->content_is_html returns TRUE.
+With a value of "xhtml" matches if $response->content_is_xhtml returns TRUE.
+
+=item m_uri__I<$method> => undef
+
+Matches if the URI object provides the method.
+
+=item m_uri__I<$method> => $string
+
+Matches if the URI's $method method returns the given value.
+
+=item m_header__I<$field> => $string
+
+Matches if either the request or the response have a header $field with the given value.
+
+=item m_response_attr__I<$key> => undef
+
+=item m_response_attr__I<$key> => $string
+
+Matches if the response object has that key, or the entry has the given value.
+
+=back
+
+=head1 SEE ALSO
+
+L<URI>, L<HTTP::Request>, L<HTTP::Response>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
+
+__END__
+
+
+#ABSTRACT: Configuration for request and response objects
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm
new file mode 100644
index 0000000000..dcbeba64d2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies.pm
@@ -0,0 +1,844 @@
+package HTTP::Cookies;
+
+use strict;
+use HTTP::Date qw(str2time parse_date time2str);
+use HTTP::Headers::Util qw(_split_header_words join_header_words);
+
+use vars qw($EPOCH_OFFSET);
+our $VERSION = '6.04';
+
+# Legacy: because "use "HTTP::Cookies" used be the ONLY way
+# to load the class HTTP::Cookies::Netscape.
+require HTTP::Cookies::Netscape;
+
+$EPOCH_OFFSET = 0; # difference from Unix epoch
+if ($^O eq "MacOS") {
+ require Time::Local;
+ $EPOCH_OFFSET = Time::Local::timelocal(0,0,0,1,0,70);
+}
+
+# A HTTP::Cookies object is a hash. The main attribute is the
+# COOKIES 3 level hash: $self->{COOKIES}{$domain}{$path}{$key}.
+
+sub new
+{
+ my $class = shift;
+ my $self = bless {
+ COOKIES => {},
+ }, $class;
+ my %cnf = @_;
+ for (keys %cnf) {
+ $self->{lc($_)} = $cnf{$_};
+ }
+ $self->load;
+ $self;
+}
+
+
+sub add_cookie_header
+{
+ my $self = shift;
+ my $request = shift || return;
+ my $url = $request->uri;
+ my $scheme = $url->scheme;
+ unless ($scheme =~ /^https?\z/) {
+ return;
+ }
+
+ my $domain = _host($request, $url);
+ $domain = "$domain.local" unless $domain =~ /\./;
+ my $secure_request = ($scheme eq "https");
+ my $req_path = _url_path($url);
+ my $req_port = $url->port;
+ my $now = time();
+ _normalize_path($req_path) if $req_path =~ /%/;
+
+ my @cval; # cookie values for the "Cookie" header
+ my $set_ver;
+ my $netscape_only = 0; # An exact domain match applies to any cookie
+
+ while ($domain =~ /\./) {
+ # Checking $domain for cookies"
+ my $cookies = $self->{COOKIES}{$domain};
+ next unless $cookies;
+ if ($self->{delayload} && defined($cookies->{'//+delayload'})) {
+ my $cookie_data = $cookies->{'//+delayload'}{'cookie'};
+ delete $self->{COOKIES}{$domain};
+ $self->load_cookie($cookie_data->[1]);
+ $cookies = $self->{COOKIES}{$domain};
+ next unless $cookies; # should not really happen
+ }
+
+ # Want to add cookies corresponding to the most specific paths
+ # first (i.e. longest path first)
+ my $path;
+ for $path (sort {length($b) <=> length($a) } keys %$cookies) {
+ if (index($req_path, $path) != 0) {
+ next;
+ }
+
+ my($key,$array);
+ while (($key,$array) = each %{$cookies->{$path}}) {
+ my($version,$val,$port,$path_spec,$secure,$expires) = @$array;
+ if ($secure && !$secure_request) {
+ next;
+ }
+ if ($expires && $expires < $now) {
+ next;
+ }
+ if ($port) {
+ my $found;
+ if ($port =~ s/^_//) {
+ # The corresponding Set-Cookie attribute was empty
+ $found++ if $port eq $req_port;
+ $port = "";
+ }
+ else {
+ my $p;
+ for $p (split(/,/, $port)) {
+ $found++, last if $p eq $req_port;
+ }
+ }
+ unless ($found) {
+ next;
+ }
+ }
+ if ($version > 0 && $netscape_only) {
+ next;
+ }
+
+ # set version number of cookie header.
+ # XXX: What should it be if multiple matching
+ # Set-Cookie headers have different versions themselves
+ if (!$set_ver++) {
+ if ($version >= 1) {
+ push(@cval, "\$Version=$version");
+ }
+ elsif (!$self->{hide_cookie2}) {
+ $request->header(Cookie2 => '$Version="1"');
+ }
+ }
+
+ # do we need to quote the value
+ if ($val =~ /\W/ && $version) {
+ $val =~ s/([\\\"])/\\$1/g;
+ $val = qq("$val");
+ }
+
+ # and finally remember this cookie
+ push(@cval, "$key=$val");
+ if ($version >= 1) {
+ push(@cval, qq(\$Path="$path")) if $path_spec;
+ push(@cval, qq(\$Domain="$domain")) if $domain =~ /^\./;
+ if (defined $port) {
+ my $p = '$Port';
+ $p .= qq(="$port") if length $port;
+ push(@cval, $p);
+ }
+ }
+
+ }
+ }
+
+ } continue {
+ # Try with a more general domain, alternately stripping
+ # leading name components and leading dots. When this
+ # results in a domain with no leading dot, it is for
+ # Netscape cookie compatibility only:
+ #
+ # a.b.c.net Any cookie
+ # .b.c.net Any cookie
+ # b.c.net Netscape cookie only
+ # .c.net Any cookie
+
+ if ($domain =~ s/^\.+//) {
+ $netscape_only = 1;
+ }
+ else {
+ $domain =~ s/[^.]*//;
+ $netscape_only = 0;
+ }
+ }
+
+ if (@cval) {
+ if (my $old = $request->header("Cookie")) {
+ unshift(@cval, $old);
+ }
+ $request->header(Cookie => join("; ", @cval));
+ if (my $hash = $request->{_http_cookies}) {
+ %$hash = (map split(/=/, $_, 2), @cval);
+ }
+ }
+
+ $request;
+}
+
+
+sub get_cookies
+{
+ my $self = shift;
+ my $url = shift;
+ $url = "https://$url" unless $url =~ m,^[a-zA-Z][a-zA-Z0-9.+\-]*:,;
+ require HTTP::Request;
+ my $req = HTTP::Request->new(GET => $url);
+ my $cookies = $req->{_http_cookies} = {};
+ $self->add_cookie_header($req);
+ if (@_) {
+ return map $cookies->{$_}, @_ if wantarray;
+ return $cookies->{$_[0]};
+ }
+ return $cookies;
+}
+
+
+sub extract_cookies
+{
+ my $self = shift;
+ my $response = shift || return;
+
+ my @set = _split_header_words($response->_header("Set-Cookie2"));
+ my @ns_set = $response->_header("Set-Cookie");
+
+ return $response unless @set || @ns_set; # quick exit
+
+ my $request = $response->request;
+ my $url = $request->uri;
+ my $req_host = _host($request, $url);
+ $req_host = "$req_host.local" unless $req_host =~ /\./;
+ my $req_port = $url->port;
+ my $req_path = _url_path($url);
+ _normalize_path($req_path) if $req_path =~ /%/;
+
+ if (@ns_set) {
+ # The old Netscape cookie format for Set-Cookie
+ # http://curl.haxx.se/rfc/cookie_spec.html
+ # can for instance contain an unquoted "," in the expires
+ # field, so we have to use this ad-hoc parser.
+ my $now = time();
+
+ # Build a hash of cookies that was present in Set-Cookie2
+ # headers. We need to skip them if we also find them in a
+ # Set-Cookie header.
+ my %in_set2;
+ for (@set) {
+ $in_set2{$_->[0]}++;
+ }
+
+ my $set;
+ for $set (@ns_set) {
+ $set =~ s/^\s+//;
+ my @cur;
+ my $param;
+ my $expires;
+ my $first_param = 1;
+ for $param (split(/;\s*/, $set)) {
+ next unless length($param);
+ my($k,$v) = split(/\s*=\s*/, $param, 2);
+ if (defined $v) {
+ $v =~ s/\s+$//;
+ #print "$k => $v\n";
+ }
+ else {
+ $k =~ s/\s+$//;
+ #print "$k => undef";
+ }
+ if (!$first_param && lc($k) eq "expires") {
+ my $etime = str2time($v);
+ if (defined $etime) {
+ push(@cur, "Max-Age" => $etime - $now);
+ $expires++;
+ }
+ else {
+ # parse_date can deal with years outside the range of time_t,
+ my($year, $mon, $day, $hour, $min, $sec, $tz) = parse_date($v);
+ if ($year) {
+ my $thisyear = (gmtime)[5] + 1900;
+ if ($year < $thisyear) {
+ push(@cur, "Max-Age" => -1); # any negative value will do
+ $expires++;
+ }
+ elsif ($year >= $thisyear + 10) {
+ # the date is at least 10 years into the future, just replace
+ # it with something approximate
+ push(@cur, "Max-Age" => 10 * 365 * 24 * 60 * 60);
+ $expires++;
+ }
+ }
+ }
+ }
+ elsif (!$first_param && lc($k) =~ /^(?:version|discard|ns-cookie)/) {
+ # ignore
+ }
+ else {
+ push(@cur, $k => $v);
+ }
+ $first_param = 0;
+ }
+ next unless @cur;
+ next if $in_set2{$cur[0]};
+
+# push(@cur, "Port" => $req_port);
+ push(@cur, "Discard" => undef) unless $expires;
+ push(@cur, "Version" => 0);
+ push(@cur, "ns-cookie" => 1);
+ push(@set, \@cur);
+ }
+ }
+
+ SET_COOKIE:
+ for my $set (@set) {
+ next unless @$set >= 2;
+
+ my $key = shift @$set;
+ my $val = shift @$set;
+
+ my %hash;
+ while (@$set) {
+ my $k = shift @$set;
+ my $v = shift @$set;
+ my $lc = lc($k);
+ # don't loose case distinction for unknown fields
+ $k = $lc if $lc =~ /^(?:discard|domain|max-age|
+ path|port|secure|version)$/x;
+ if ($k eq "discard" || $k eq "secure") {
+ $v = 1 unless defined $v;
+ }
+ next if exists $hash{$k}; # only first value is significant
+ $hash{$k} = $v;
+ };
+
+ my %orig_hash = %hash;
+ my $version = delete $hash{version};
+ $version = 1 unless defined($version);
+ my $discard = delete $hash{discard};
+ my $secure = delete $hash{secure};
+ my $maxage = delete $hash{'max-age'};
+ my $ns_cookie = delete $hash{'ns-cookie'};
+
+ # Check domain
+ my $domain = delete $hash{domain};
+ $domain = lc($domain) if defined $domain;
+ if (defined($domain)
+ && $domain ne $req_host && $domain ne ".$req_host") {
+ if ($domain !~ /\./ && $domain ne "local") {
+ next SET_COOKIE;
+ }
+ $domain = ".$domain" unless $domain =~ /^\./;
+ if ($domain =~ /\.\d+$/) {
+ next SET_COOKIE;
+ }
+ my $len = length($domain);
+ unless (substr($req_host, -$len) eq $domain) {
+ next SET_COOKIE;
+ }
+ my $hostpre = substr($req_host, 0, length($req_host) - $len);
+ if ($hostpre =~ /\./ && !$ns_cookie) {
+ next SET_COOKIE;
+ }
+ }
+ else {
+ $domain = $req_host;
+ }
+
+ my $path = delete $hash{path};
+ my $path_spec;
+ if (defined $path && $path ne '') {
+ $path_spec++;
+ _normalize_path($path) if $path =~ /%/;
+ if (!$ns_cookie &&
+ substr($req_path, 0, length($path)) ne $path) {
+ next SET_COOKIE;
+ }
+ }
+ else {
+ $path = $req_path;
+ $path =~ s,/[^/]*$,,;
+ $path = "/" unless length($path);
+ }
+
+ my $port;
+ if (exists $hash{port}) {
+ $port = delete $hash{port};
+ if (defined $port) {
+ $port =~ s/\s+//g;
+ my $found;
+ for my $p (split(/,/, $port)) {
+ unless ($p =~ /^\d+$/) {
+ next SET_COOKIE;
+ }
+ $found++ if $p eq $req_port;
+ }
+ unless ($found) {
+ next SET_COOKIE;
+ }
+ }
+ else {
+ $port = "_$req_port";
+ }
+ }
+ $self->set_cookie($version,$key,$val,$path,$domain,$port,$path_spec,$secure,$maxage,$discard, \%hash)
+ if $self->set_cookie_ok(\%orig_hash);
+ }
+
+ $response;
+}
+
+sub set_cookie_ok
+{
+ 1;
+}
+
+
+sub set_cookie
+{
+ my $self = shift;
+ my($version,
+ $key, $val, $path, $domain, $port,
+ $path_spec, $secure, $maxage, $discard, $rest) = @_;
+
+ # path and key can not be empty (key can't start with '$')
+ return $self if !defined($path) || $path !~ m,^/, ||
+ !defined($key) || $key =~ m,^\$,;
+
+ # ensure legal port
+ if (defined $port) {
+ return $self unless $port =~ /^_?\d+(?:,\d+)*$/;
+ }
+
+ my $expires;
+ if (defined $maxage) {
+ if ($maxage <= 0) {
+ delete $self->{COOKIES}{$domain}{$path}{$key};
+ return $self;
+ }
+ $expires = time() + $maxage;
+ }
+ $version = 0 unless defined $version;
+
+ my @array = ($version, $val,$port,
+ $path_spec,
+ $secure, $expires, $discard);
+ push(@array, {%$rest}) if defined($rest) && %$rest;
+ # trim off undefined values at end
+ pop(@array) while !defined $array[-1];
+
+ $self->{COOKIES}{$domain}{$path}{$key} = \@array;
+ $self;
+}
+
+
+sub save
+{
+ my $self = shift;
+ my $file = shift || $self->{'file'} || return;
+ open(my $fh, '>', $file) or die "Can't open $file: $!";
+ print {$fh} "#LWP-Cookies-1.0\n";
+ print {$fh} $self->as_string(!$self->{ignore_discard});
+ 1;
+}
+
+
+sub load
+{
+ my $self = shift;
+ my $file = shift || $self->{'file'} || return;
+
+ local $/ = "\n"; # make sure we got standard record separator
+ open(my $fh, '<', $file) or return;
+
+ # check that we have the proper header
+ my $magic = <$fh>;
+ chomp $magic;
+ unless ($magic =~ /^#LWP-Cookies-\d+\.\d+/) {
+ warn "$file does not seem to contain cookies";
+ return;
+ }
+
+ # go through the file
+ while (my $line = <$fh>) {
+ chomp $line;
+ next unless $line =~ s/^Set-Cookie3:\s*//;
+ my $cookie;
+ for $cookie (_split_header_words($line)) {
+ my($key,$val) = splice(@$cookie, 0, 2);
+ my %hash;
+ while (@$cookie) {
+ my $k = shift @$cookie;
+ my $v = shift @$cookie;
+ $hash{$k} = $v;
+ }
+ my $version = delete $hash{version};
+ my $path = delete $hash{path};
+ my $domain = delete $hash{domain};
+ my $port = delete $hash{port};
+ my $expires = str2time(delete $hash{expires});
+
+ my $path_spec = exists $hash{path_spec}; delete $hash{path_spec};
+ my $secure = exists $hash{secure}; delete $hash{secure};
+ my $discard = exists $hash{discard}; delete $hash{discard};
+
+ my @array = ($version, $val, $port, $path_spec, $secure, $expires,
+ $discard);
+ push(@array, \%hash) if %hash;
+ $self->{COOKIES}{$domain}{$path}{$key} = \@array;
+ }
+ }
+ 1;
+}
+
+
+sub revert
+{
+ my $self = shift;
+ $self->clear->load;
+ $self;
+}
+
+
+sub clear
+{
+ my $self = shift;
+ if (@_ == 0) {
+ $self->{COOKIES} = {};
+ }
+ elsif (@_ == 1) {
+ delete $self->{COOKIES}{$_[0]};
+ }
+ elsif (@_ == 2) {
+ delete $self->{COOKIES}{$_[0]}{$_[1]};
+ }
+ elsif (@_ == 3) {
+ delete $self->{COOKIES}{$_[0]}{$_[1]}{$_[2]};
+ }
+ else {
+ require Carp;
+ Carp::carp('Usage: $c->clear([domain [,path [,key]]])');
+ }
+ $self;
+}
+
+
+sub clear_temporary_cookies
+{
+ my($self) = @_;
+
+ $self->scan(sub {
+ if($_[9] or # "Discard" flag set
+ not $_[8]) { # No expire field?
+ $_[8] = -1; # Set the expire/max_age field
+ $self->set_cookie(@_); # Clear the cookie
+ }
+ });
+}
+
+
+sub DESTROY
+{
+ my $self = shift;
+ local($., $@, $!, $^E, $?);
+ $self->save if $self->{'autosave'};
+}
+
+
+sub scan
+{
+ my($self, $cb) = @_;
+ my($domain,$path,$key);
+ for $domain (sort keys %{$self->{COOKIES}}) {
+ for $path (sort keys %{$self->{COOKIES}{$domain}}) {
+ for $key (sort keys %{$self->{COOKIES}{$domain}{$path}}) {
+ my($version,$val,$port,$path_spec,
+ $secure,$expires,$discard,$rest) =
+ @{$self->{COOKIES}{$domain}{$path}{$key}};
+ $rest = {} unless defined($rest);
+ &$cb($version,$key,$val,$path,$domain,$port,
+ $path_spec,$secure,$expires,$discard,$rest);
+ }
+ }
+ }
+}
+
+
+sub as_string
+{
+ my($self, $skip_discard) = @_;
+ my @res;
+ $self->scan(sub {
+ my($version,$key,$val,$path,$domain,$port,
+ $path_spec,$secure,$expires,$discard,$rest) = @_;
+ return if $discard && $skip_discard;
+ my @h = ($key, $val);
+ push(@h, "path", $path);
+ push(@h, "domain" => $domain);
+ push(@h, "port" => $port) if defined $port;
+ push(@h, "path_spec" => undef) if $path_spec;
+ push(@h, "secure" => undef) if $secure;
+ push(@h, "expires" => HTTP::Date::time2isoz($expires)) if $expires;
+ push(@h, "discard" => undef) if $discard;
+ my $k;
+ for $k (sort keys %$rest) {
+ push(@h, $k, $rest->{$k});
+ }
+ push(@h, "version" => $version);
+ push(@res, "Set-Cookie3: " . join_header_words(\@h));
+ });
+ join("\n", @res, "");
+}
+
+sub _host
+{
+ my($request, $url) = @_;
+ if (my $h = $request->header("Host")) {
+ $h =~ s/:\d+$//; # might have a port as well
+ return lc($h);
+ }
+ return lc($url->host);
+}
+
+sub _url_path
+{
+ my $url = shift;
+ my $path;
+ if($url->can('epath')) {
+ $path = $url->epath; # URI::URL method
+ }
+ else {
+ $path = $url->path; # URI::_generic method
+ }
+ $path = "/" unless length $path;
+ $path;
+}
+
+sub _normalize_path # so that plain string compare can be used
+{
+ my $x;
+ $_[0] =~ s/%([0-9a-fA-F][0-9a-fA-F])/
+ $x = uc($1);
+ $x eq "2F" || $x eq "25" ? "%$x" :
+ pack("C", hex($x));
+ /eg;
+ $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Cookies - HTTP cookie jars
+
+=head1 VERSION
+
+version 6.04
+
+=head1 SYNOPSIS
+
+ use HTTP::Cookies;
+ $cookie_jar = HTTP::Cookies->new(
+ file => "$ENV{'HOME'}/lwp_cookies.dat",
+ autosave => 1,
+ );
+
+ use LWP;
+ my $browser = LWP::UserAgent->new;
+ $browser->cookie_jar($cookie_jar);
+
+Or for an empty and temporary cookie jar:
+
+ use LWP;
+ my $browser = LWP::UserAgent->new;
+ $browser->cookie_jar( {} );
+
+=head1 DESCRIPTION
+
+This class is for objects that represent a "cookie jar" -- that is, a
+database of all the HTTP cookies that a given LWP::UserAgent object
+knows about.
+
+Cookies are a general mechanism which server side connections can use
+to both store and retrieve information on the client side of the
+connection. For more information about cookies refer to
+<URL:http://curl.haxx.se/rfc/cookie_spec.html> and
+<URL:http://www.cookiecentral.com/>. This module also implements the
+new style cookies described in L<RFC 2965|https://tools.ietf.org/html/rfc2965>.
+The two variants of cookies are supposed to be able to coexist happily.
+
+Instances of the class I<HTTP::Cookies> are able to store a collection
+of Set-Cookie2: and Set-Cookie: headers and are able to use this
+information to initialize Cookie-headers in I<HTTP::Request> objects.
+The state of a I<HTTP::Cookies> object can be saved in and restored from
+files.
+
+=head1 LIMITATIONS
+
+This module does not support L<< Public Suffix|https://publicsuffix.org/
+>> encouraged by a more recent standard, L<< RFC
+6265|https://tools.ietf.org/html/rfc6265 >>.
+
+This module's shortcomings mean that a malicious Web site can set
+cookies to track your user agent across all sites under a top level
+domain. See F<< t/publicsuffix.t >> in this module's distribution for
+details.
+
+L<< HTTP::CookieJar::LWP >> supports Public Suffix, but only provides a
+limited subset of this module's functionality and L<< does not
+support|HTTP::CookieJar/LIMITATIONS-AND-CAVEATS >> standards older than
+I<RFC 6265>.
+
+=head1 METHODS
+
+The following methods are provided:
+
+=over 4
+
+=item $cookie_jar = HTTP::Cookies->new
+
+The constructor takes hash style parameters. The following
+parameters are recognized:
+
+ file: name of the file to restore cookies from and save cookies to
+ autosave: save during destruction (bool)
+ ignore_discard: save even cookies that are requested to be discarded (bool)
+ hide_cookie2: do not add Cookie2 header to requests
+
+Future parameters might include (not yet implemented):
+
+ max_cookies 300
+ max_cookies_per_domain 20
+ max_cookie_size 4096
+
+ no_cookies list of domain names that we never return cookies to
+
+=item $cookie_jar->get_cookies( $url_or_domain )
+
+=item $cookie_jar->get_cookies( $url_or_domain, $cookie_key,... )
+
+Returns a hash of the cookies that applies to the given URL. If a
+domainname is given as argument, then a prefix of "https://" is assumed.
+
+If one or more $cookie_key parameters are provided return the given values,
+or C<undef> if the cookie isn't available.
+
+=item $cookie_jar->add_cookie_header( $request )
+
+The add_cookie_header() method will set the appropriate Cookie:-header
+for the I<HTTP::Request> object given as argument. The $request must
+have a valid url attribute before this method is called.
+
+=item $cookie_jar->extract_cookies( $response )
+
+The extract_cookies() method will look for Set-Cookie: and
+Set-Cookie2: headers in the I<HTTP::Response> object passed as
+argument. Any of these headers that are found are used to update
+the state of the $cookie_jar.
+
+=item $cookie_jar->set_cookie( $version, $key, $val, $path, $domain, $port, $path_spec, $secure, $maxage, $discard, \%rest )
+
+The set_cookie() method updates the state of the $cookie_jar. The
+$key, $val, $domain, $port and $path arguments are strings. The
+$path_spec, $secure, $discard arguments are boolean values. The $maxage
+value is a number indicating number of seconds that this cookie will
+live. A value of $maxage <= 0 will delete this cookie. %rest defines
+various other attributes like "Comment" and "CommentURL".
+
+=item $cookie_jar->save
+
+=item $cookie_jar->save( $file )
+
+This method file 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 attribute I<ignore_discard> is set, then we
+will even save cookies that are marked to be discarded.
+
+The default is to save a sequence of "Set-Cookie3" lines.
+"Set-Cookie3" is a proprietary LWP format, not known to be compatible
+with any browser. The I<HTTP::Cookies::Netscape> sub-class can
+be used to save in a format compatible with Netscape.
+
+=item $cookie_jar->load
+
+=item $cookie_jar->load( $file )
+
+This method reads the cookies from the file and adds them to the
+$cookie_jar. The file must be in the format written by the save()
+method.
+
+=item $cookie_jar->revert
+
+This method empties the $cookie_jar and re-loads the $cookie_jar
+from the last save file.
+
+=item $cookie_jar->clear
+
+=item $cookie_jar->clear( $domain )
+
+=item $cookie_jar->clear( $domain, $path )
+
+=item $cookie_jar->clear( $domain, $path, $key )
+
+Invoking this method without arguments will empty the whole
+$cookie_jar. If given a single argument only cookies belonging to
+that domain will be removed. If given two arguments, cookies
+belonging to the specified path within that domain are removed. If
+given three arguments, then the cookie with the specified key, path
+and domain is removed.
+
+=item $cookie_jar->clear_temporary_cookies
+
+Discard all temporary cookies. Scans for all cookies in the jar
+with either no expire field or a true C<discard> flag. To be
+called when the user agent shuts down according to RFC 2965.
+
+=item $cookie_jar->scan( \&callback )
+
+The argument is a subroutine that will be invoked for each cookie
+stored in the $cookie_jar. The subroutine will be invoked with
+the following arguments:
+
+ 0 version
+ 1 key
+ 2 val
+ 3 path
+ 4 domain
+ 5 port
+ 6 path_spec
+ 7 secure
+ 8 expires
+ 9 discard
+ 10 hash
+
+=item $cookie_jar->as_string
+
+=item $cookie_jar->as_string( $skip_discardables )
+
+The as_string() method will return the state of the $cookie_jar
+represented as a sequence of "Set-Cookie3" header lines separated by
+"\n". If $skip_discardables is TRUE, it will not return lines for
+cookies with the I<Discard> attribute.
+
+=back
+
+=head1 SEE ALSO
+
+L<HTTP::Cookies::Netscape>, L<HTTP::Cookies::Microsoft>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2002-2017 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.
+
+=cut
+
+__END__
+#ABSTRACT: HTTP cookie jars
+
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
new file mode 100644
index 0000000000..737da2829f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Microsoft.pm
@@ -0,0 +1,326 @@
+package HTTP::Cookies::Microsoft;
+
+use strict;
+
+use vars qw(@ISA);
+
+our $VERSION = '6.04';
+
+require HTTP::Cookies;
+@ISA=qw(HTTP::Cookies);
+
+sub load_cookies_from_file
+{
+ my ($file) = @_;
+ my @cookies;
+
+ open (my $fh, '<', $file) || return;
+
+ while (my $key = <$fh>) {
+ chomp $key;
+ my ($value, $domain_path, $flags, $lo_expire, $hi_expire);
+ my ($lo_create, $hi_create, $sep);
+ chomp($value = <$fh>);
+ chomp($domain_path= <$fh>);
+ chomp($flags = <$fh>); # 0x0001 bit is for secure
+ chomp($lo_expire = <$fh>);
+ chomp($hi_expire = <$fh>);
+ chomp($lo_create = <$fh>);
+ chomp($hi_create = <$fh>);
+ chomp($sep = <$fh>);
+
+ if (!defined($key) || !defined($value) || !defined($domain_path) ||
+ !defined($flags) || !defined($hi_expire) || !defined($lo_expire) ||
+ !defined($hi_create) || !defined($lo_create) || !defined($sep) ||
+ ($sep ne '*'))
+ {
+ last;
+ }
+
+ if ($domain_path =~ /^([^\/]+)(\/.*)$/) {
+ my $domain = $1;
+ my $path = $2;
+
+ push @cookies, {
+ KEY => $key, VALUE => $value, DOMAIN => $domain,
+ PATH => $path, FLAGS =>$flags, HIXP =>$hi_expire,
+ LOXP => $lo_expire, HICREATE => $hi_create,
+ LOCREATE => $lo_create
+ };
+ }
+ }
+
+ return \@cookies;
+}
+
+sub get_user_name
+{
+ use Win32;
+ use locale;
+ my $user = lc(Win32::LoginName());
+
+ return $user;
+}
+
+# MSIE stores create and expire times as Win32 FILETIME,
+# which is 64 bits of 100 nanosecond intervals since Jan 01 1601
+#
+# But Cookies code expects time in 32-bit value expressed
+# in seconds since Jan 01 1970
+#
+sub epoch_time_offset_from_win32_filetime
+{
+ my ($high, $low) = @_;
+
+ #--------------------------------------------------------
+ # USEFUL CONSTANT
+ #--------------------------------------------------------
+ # 0x019db1de 0xd53e8000 is 1970 Jan 01 00:00:00 in Win32 FILETIME
+ #
+ # 100 nanosecond intervals == 0.1 microsecond intervals
+
+ my $filetime_low32_1970 = 0xd53e8000;
+ my $filetime_high32_1970 = 0x019db1de;
+
+ #------------------------------------
+ # ALGORITHM
+ #------------------------------------
+ # To go from 100 nanosecond intervals to seconds since 00:00 Jan 01 1970:
+ #
+ # 1. Adjust 100 nanosecond intervals to Jan 01 1970 base
+ # 2. Divide by 10 to get to microseconds (1/millionth second)
+ # 3. Divide by 1000000 (10 ^ 6) to get to seconds
+ #
+ # We can combine Step 2 & 3 into one divide.
+ #
+ # After much trial and error, I came up with the following code which
+ # avoids using Math::BigInt or floating pt, but still gives correct answers
+
+ # If the filetime is before the epoch, return 0
+ if (($high < $filetime_high32_1970) ||
+ (($high == $filetime_high32_1970) && ($low < $filetime_low32_1970)))
+ {
+ return 0;
+ }
+
+ # Can't multiply by 0x100000000, (1 << 32),
+ # without Perl issuing an integer overflow warning
+ #
+ # So use two multiplies by 0x10000 instead of one multiply by 0x100000000
+ #
+ # The result is the same.
+ #
+ my $date1970 = (($filetime_high32_1970 * 0x10000) * 0x10000) + $filetime_low32_1970;
+ my $time = (($high * 0x10000) * 0x10000) + $low;
+
+ $time -= $date1970;
+ $time /= 10000000;
+
+ return $time;
+}
+
+sub load_cookie
+{
+ my($self, $file) = @_;
+ my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
+ my $cookie_data;
+
+ if (-f $file)
+ {
+ # open the cookie file and get the data
+ $cookie_data = load_cookies_from_file($file);
+
+ foreach my $cookie (@{$cookie_data})
+ {
+ my $secure = ($cookie->{FLAGS} & 1) != 0;
+ my $expires = epoch_time_offset_from_win32_filetime($cookie->{HIXP}, $cookie->{LOXP});
+
+ $self->set_cookie(undef, $cookie->{KEY}, $cookie->{VALUE},
+ $cookie->{PATH}, $cookie->{DOMAIN}, undef,
+ 0, $secure, $expires-$now, 0);
+ }
+ }
+}
+
+sub load
+{
+ my($self, $cookie_index) = @_;
+ my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
+ my $cookie_dir = '';
+ my $delay_load = (defined($self->{'delayload'}) && $self->{'delayload'});
+ my $user_name = get_user_name();
+ my $data;
+
+ $cookie_index ||= $self->{'file'} || return;
+ if ($cookie_index =~ /[\\\/][^\\\/]+$/) {
+ $cookie_dir = $` . "\\";
+ }
+
+ open (my $fh, '<:raw', $cookie_index) || return;
+ if (256 != read($fh, $data, 256)) {
+ warn "$cookie_index file is not large enough";
+ return;
+ }
+
+ # Cookies' index.dat file starts with 32 bytes of signature
+ # followed by an offset to the first record, stored as a little-endian DWORD
+ my ($sig, $size) = unpack('a32 V', $data);
+
+ # check that sig is valid (only tested in IE6.0)
+ if (($sig !~ /^Client UrlCache MMF Ver 5\.2/) || (0x4000 != $size)) {
+ warn "$cookie_index ['$sig' $size] does not seem to contain cookies";
+ return;
+ }
+
+ # move the file ptr to start of the first record
+ if (0 == seek($fh, $size, 0)) {
+ return;
+ }
+
+ # Cookies are usually stored in 'URL ' records in two contiguous 0x80 byte sectors (256 bytes)
+ # so read in two 0x80 byte sectors and adjust if not a Cookie.
+ while (256 == read($fh, $data, 256)) {
+ # each record starts with a 4-byte signature
+ # and a count (little-endian DWORD) of 0x80 byte sectors for the record
+ ($sig, $size) = unpack('a4 V', $data);
+
+ # Cookies are found in 'URL ' records
+ if ('URL ' ne $sig) {
+ # skip over uninteresting record: I've seen 'HASH' and 'LEAK' records
+ if (($sig eq 'HASH') || ($sig eq 'LEAK')) {
+ # '-2' takes into account the two 0x80 byte sectors we've just read in
+ if (($size > 0) && ($size != 2)) {
+ if (0 == seek($fh, ($size-2)*0x80, 1)) {
+ # Seek failed. Something's wrong. Gonna stop.
+ last;
+ }
+ }
+ }
+ next;
+ }
+
+ #$REMOVE Need to check if URL records in Cookies' index.dat will
+ # ever use more than two 0x80 byte sectors
+ if ($size > 2) {
+ my $more_data = ($size-2)*0x80;
+
+ if ($more_data != read($fh, $data, $more_data, 256)) {
+ last;
+ }
+ }
+
+ (my $user_name2 = $user_name) =~ s/ /_/g;
+ if ($data =~ /Cookie:\Q$user_name\E@([\x21-\xFF]+).*?((?:\Q$user_name\E|\Q$user_name2\E)@[\x21-\xFF]+\.txt)/) {
+ my $cookie_file = $cookie_dir . $2; # form full pathname
+
+ if (!$delay_load) {
+ $self->load_cookie($cookie_file);
+ }
+ else {
+ my $domain = $1;
+
+ # grab only the domain name, drop everything from the first dir sep on
+ if ($domain =~ m{[\\/]}) {
+ $domain = $`;
+ }
+
+ # set the delayload cookie for this domain with
+ # the cookie_file as cookie for later-loading info
+ $self->set_cookie(undef, 'cookie', $cookie_file, '//+delayload', $domain, undef, 0, 0, $now+86400, 0);
+ }
+ }
+ }
+
+ 1;
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Cookies::Microsoft - Access to Microsoft cookies files
+
+=head1 VERSION
+
+version 6.04
+
+=head1 SYNOPSIS
+
+ use LWP;
+ use HTTP::Cookies::Microsoft;
+ use Win32::TieRegistry(Delimiter => "/");
+ my $cookies_dir = $Registry->
+ {"CUser/Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders/Cookies"};
+
+ $cookie_jar = HTTP::Cookies::Microsoft->new(
+ file => "$cookies_dir\\index.dat",
+ 'delayload' => 1,
+ );
+ my $browser = LWP::UserAgent->new;
+ $browser->cookie_jar( $cookie_jar );
+
+=head1 DESCRIPTION
+
+This is a subclass of C<HTTP::Cookies> which
+loads Microsoft Internet Explorer 5.x and 6.x for Windows (MSIE)
+cookie files.
+
+See the documentation for L<HTTP::Cookies>.
+
+=head1 METHODS
+
+The following methods are provided:
+
+=over 4
+
+=item $cookie_jar = HTTP::Cookies::Microsoft->new;
+
+The constructor takes hash style parameters. In addition
+to the regular HTTP::Cookies parameters, HTTP::Cookies::Microsoft
+recognizes the following:
+
+ delayload: delay loading of cookie data until a request
+ is actually made. This results in faster
+ runtime unless you use most of the cookies
+ since only the domain's cookie data
+ is loaded on demand.
+
+=back
+
+=head1 CAVEATS
+
+Please note that the code DOESN'T support saving to the MSIE
+cookie file format.
+
+=head1 AUTHOR
+
+Johnny Lee <typo_pl@hotmail.com>
+
+=head1 COPYRIGHT
+
+Copyright 2002 Johnny Lee
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2002-2017 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.
+
+=cut
+
+__END__
+
+#ABSTRACT: Access to Microsoft cookies files
+
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
new file mode 100644
index 0000000000..8fbac88849
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Cookies/Netscape.pm
@@ -0,0 +1,127 @@
+package HTTP::Cookies::Netscape;
+
+use strict;
+use vars qw(@ISA);
+
+our $VERSION = '6.04';
+
+require HTTP::Cookies;
+@ISA=qw(HTTP::Cookies);
+
+sub load
+{
+ my ($self, $file) = @_;
+ $file ||= $self->{'file'} || return;
+
+ local $/ = "\n"; # make sure we got standard record separator
+ open (my $fh, '<', $file) || return;
+ my $magic = <$fh>;
+ chomp $magic;
+ unless ($magic =~ /^#(?: Netscape)? HTTP Cookie File/) {
+ warn "$file does not look like a netscape cookies file";
+ return;
+ }
+
+ my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
+ while (my $line = <$fh>) {
+ chomp($line);
+ next if $line =~ /^\s*\#/;
+ next if $line =~ /^\s*$/;
+ $line =~ tr/\n\r//d;
+ my($domain,$bool1,$path,$secure, $expires,$key,$val) = split(/\t/, $line);
+ $secure = ($secure eq "TRUE");
+ $self->set_cookie(undef, $key, $val, $path, $domain, undef, 0, $secure, $expires-$now, 0);
+ }
+ 1;
+}
+
+sub save
+{
+ my($self, $file) = @_;
+ $file ||= $self->{'file'} || return;
+
+ open(my $fh, '>', $file) || return;
+
+ # Use old, now broken link to the old cookie spec just in case something
+ # else (not us!) requires the comment block exactly this way.
+ print {$fh} <<EOT;
+# Netscape HTTP Cookie File
+# http://www.netscape.com/newsref/std/cookie_spec.html
+# This is a generated file! Do not edit.
+
+EOT
+
+ my $now = time - $HTTP::Cookies::EPOCH_OFFSET;
+ $self->scan(sub {
+ my ($version, $key, $val, $path, $domain, $port, $path_spec, $secure, $expires, $discard, $rest) = @_;
+ return if $discard && !$self->{ignore_discard};
+ $expires = $expires ? $expires - $HTTP::Cookies::EPOCH_OFFSET : 0;
+ return if $now > $expires;
+ $secure = $secure ? "TRUE" : "FALSE";
+ my $bool = $domain =~ /^\./ ? "TRUE" : "FALSE";
+ print {$fh} join("\t", $domain, $bool, $path, $secure, $expires, $key, $val), "\n";
+ });
+ 1;
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Cookies::Netscape - Access to Netscape cookies files
+
+=head1 VERSION
+
+version 6.04
+
+=head1 SYNOPSIS
+
+ use LWP;
+ use HTTP::Cookies::Netscape;
+ $cookie_jar = HTTP::Cookies::Netscape->new(
+ file => "c:/program files/netscape/users/ZombieCharity/cookies.txt",
+ );
+ my $browser = LWP::UserAgent->new;
+ $browser->cookie_jar( $cookie_jar );
+
+=head1 DESCRIPTION
+
+This is a subclass of C<HTTP::Cookies> that reads (and optionally
+writes) Netscape/Mozilla cookie files.
+
+See the documentation for L<HTTP::Cookies>.
+
+=head1 CAVEATS
+
+Please note that the Netscape/Mozilla cookie file format can't store
+all the information available in the Set-Cookie2 headers, so you will
+probably lose some information if you save in this format.
+
+At time of writing, this module seems to work fine with Mozilla
+Phoenix/Firebird.
+
+=head1 SEE ALSO
+
+L<HTTP::Cookies::Microsoft>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2002-2017 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.
+
+=cut
+
+__END__
+
+#ABSTRACT: Access to Netscape cookies files
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm
new file mode 100644
index 0000000000..27a7bf4e17
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Daemon.pm
@@ -0,0 +1,906 @@
+package HTTP::Daemon;
+
+use strict;
+use vars qw($VERSION @ISA $PROTO $DEBUG);
+
+$VERSION = "6.01";
+
+use IO::Socket qw(AF_INET INADDR_ANY INADDR_LOOPBACK inet_ntoa);
+@ISA=qw(IO::Socket::INET);
+
+$PROTO = "HTTP/1.1";
+
+
+sub new
+{
+ my($class, %args) = @_;
+ $args{Listen} ||= 5;
+ $args{Proto} ||= 'tcp';
+ return $class->SUPER::new(%args);
+}
+
+
+sub accept
+{
+ my $self = shift;
+ my $pkg = shift || "HTTP::Daemon::ClientConn";
+ my ($sock, $peer) = $self->SUPER::accept($pkg);
+ if ($sock) {
+ ${*$sock}{'httpd_daemon'} = $self;
+ return wantarray ? ($sock, $peer) : $sock;
+ }
+ else {
+ return;
+ }
+}
+
+
+sub url
+{
+ my $self = shift;
+ my $url = $self->_default_scheme . "://";
+ my $addr = $self->sockaddr;
+ if (!$addr || $addr eq INADDR_ANY) {
+ require Sys::Hostname;
+ $url .= lc Sys::Hostname::hostname();
+ }
+ elsif ($addr eq INADDR_LOOPBACK) {
+ $url .= inet_ntoa($addr);
+ }
+ else {
+ $url .= gethostbyaddr($addr, AF_INET) || inet_ntoa($addr);
+ }
+ my $port = $self->sockport;
+ $url .= ":$port" if $port != $self->_default_port;
+ $url .= "/";
+ $url;
+}
+
+
+sub _default_port {
+ 80;
+}
+
+
+sub _default_scheme {
+ "http";
+}
+
+
+sub product_tokens
+{
+ "libwww-perl-daemon/$HTTP::Daemon::VERSION";
+}
+
+
+
+package HTTP::Daemon::ClientConn;
+
+use vars qw(@ISA $DEBUG);
+use IO::Socket ();
+@ISA=qw(IO::Socket::INET);
+*DEBUG = \$HTTP::Daemon::DEBUG;
+
+use HTTP::Request ();
+use HTTP::Response ();
+use HTTP::Status;
+use HTTP::Date qw(time2str);
+use LWP::MediaTypes qw(guess_media_type);
+use Carp ();
+
+my $CRLF = "\015\012"; # "\r\n" is not portable
+my $HTTP_1_0 = _http_version("HTTP/1.0");
+my $HTTP_1_1 = _http_version("HTTP/1.1");
+
+
+sub get_request
+{
+ my($self, $only_headers) = @_;
+ if (${*$self}{'httpd_nomore'}) {
+ $self->reason("No more requests from this connection");
+ return;
+ }
+
+ $self->reason("");
+ my $buf = ${*$self}{'httpd_rbuf'};
+ $buf = "" unless defined $buf;
+
+ my $timeout = $ {*$self}{'io_socket_timeout'};
+ my $fdset = "";
+ vec($fdset, $self->fileno, 1) = 1;
+ local($_);
+
+ READ_HEADER:
+ while (1) {
+ # loop until we have the whole header in $buf
+ $buf =~ s/^(?:\015?\012)+//; # ignore leading blank lines
+ if ($buf =~ /\012/) { # potential, has at least one line
+ if ($buf =~ /^\w+[^\012]+HTTP\/\d+\.\d+\015?\012/) {
+ if ($buf =~ /\015?\012\015?\012/) {
+ last READ_HEADER; # we have it
+ }
+ elsif (length($buf) > 16*1024) {
+ $self->send_error(413); # REQUEST_ENTITY_TOO_LARGE
+ $self->reason("Very long header");
+ return;
+ }
+ }
+ else {
+ last READ_HEADER; # HTTP/0.9 client
+ }
+ }
+ elsif (length($buf) > 16*1024) {
+ $self->send_error(414); # REQUEST_URI_TOO_LARGE
+ $self->reason("Very long first line");
+ return;
+ }
+ print STDERR "Need more data for complete header\n" if $DEBUG;
+ return unless $self->_need_more($buf, $timeout, $fdset);
+ }
+ if ($buf !~ s/^(\S+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012//) {
+ ${*$self}{'httpd_client_proto'} = _http_version("HTTP/1.0");
+ $self->send_error(400); # BAD_REQUEST
+ $self->reason("Bad request line: $buf");
+ return;
+ }
+ my $method = $1;
+ my $uri = $2;
+ my $proto = $3 || "HTTP/0.9";
+ $uri = "http://$uri" if $method eq "CONNECT";
+ $uri = $HTTP::URI_CLASS->new($uri, $self->daemon->url);
+ my $r = HTTP::Request->new($method, $uri);
+ $r->protocol($proto);
+ ${*$self}{'httpd_client_proto'} = $proto = _http_version($proto);
+ ${*$self}{'httpd_head'} = ($method eq "HEAD");
+
+ if ($proto >= $HTTP_1_0) {
+ # we expect to find some headers
+ my($key, $val);
+ HEADER:
+ while ($buf =~ s/^([^\012]*)\012//) {
+ $_ = $1;
+ s/\015$//;
+ if (/^([^:\s]+)\s*:\s*(.*)/) {
+ $r->push_header($key, $val) if $key;
+ ($key, $val) = ($1, $2);
+ }
+ elsif (/^\s+(.*)/) {
+ $val .= " $1";
+ }
+ else {
+ last HEADER;
+ }
+ }
+ $r->push_header($key, $val) if $key;
+ }
+
+ my $conn = $r->header('Connection');
+ if ($proto >= $HTTP_1_1) {
+ ${*$self}{'httpd_nomore'}++ if $conn && lc($conn) =~ /\bclose\b/;
+ }
+ else {
+ ${*$self}{'httpd_nomore'}++ unless $conn &&
+ lc($conn) =~ /\bkeep-alive\b/;
+ }
+
+ if ($only_headers) {
+ ${*$self}{'httpd_rbuf'} = $buf;
+ return $r;
+ }
+
+ # 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');
+
+ # Act on the Expect header, if it's there
+ for my $e ( $r->header('Expect') ) {
+ if( lc($e) eq '100-continue' ) {
+ $self->send_status_line(100);
+ $self->send_crlf;
+ }
+ else {
+ $self->send_error(417);
+ $self->reason("Unsupported Expect header value");
+ return;
+ }
+ }
+
+ if ($te && lc($te) eq 'chunked') {
+ # Handle chunked transfer encoding
+ my $body = "";
+ CHUNK:
+ while (1) {
+ print STDERR "Chunked\n" if $DEBUG;
+ if ($buf =~ s/^([^\012]*)\012//) {
+ my $chunk_head = $1;
+ unless ($chunk_head =~ /^([0-9A-Fa-f]+)/) {
+ $self->send_error(400);
+ $self->reason("Bad chunk header $chunk_head");
+ return;
+ }
+ my $size = hex($1);
+ last CHUNK if $size == 0;
+
+ my $missing = $size - length($buf) + 2; # 2=CRLF at chunk end
+ # must read until we have a complete chunk
+ while ($missing > 0) {
+ print STDERR "Need $missing more bytes\n" if $DEBUG;
+ my $n = $self->_need_more($buf, $timeout, $fdset);
+ return unless $n;
+ $missing -= $n;
+ }
+ $body .= substr($buf, 0, $size);
+ substr($buf, 0, $size+2) = '';
+
+ }
+ else {
+ # need more data in order to have a complete chunk header
+ return unless $self->_need_more($buf, $timeout, $fdset);
+ }
+ }
+ $r->content($body);
+
+ # pretend it was a normal entity body
+ $r->remove_header('Transfer-Encoding');
+ $r->header('Content-Length', length($body));
+
+ my($key, $val);
+ FOOTER:
+ while (1) {
+ if ($buf !~ /\012/) {
+ # need at least one line to look at
+ return unless $self->_need_more($buf, $timeout, $fdset);
+ }
+ else {
+ $buf =~ s/^([^\012]*)\012//;
+ $_ = $1;
+ s/\015$//;
+ if (/^([\w\-]+)\s*:\s*(.*)/) {
+ $r->push_header($key, $val) if $key;
+ ($key, $val) = ($1, $2);
+ }
+ elsif (/^\s+(.*)/) {
+ $val .= " $1";
+ }
+ elsif (!length) {
+ last FOOTER;
+ }
+ else {
+ $self->reason("Bad footer syntax");
+ return;
+ }
+ }
+ }
+ $r->push_header($key, $val) if $key;
+
+ }
+ elsif ($te) {
+ $self->send_error(501); # Unknown transfer encoding
+ $self->reason("Unknown transfer encoding '$te'");
+ return;
+
+ }
+ elsif ($len) {
+ # Plain body specified by "Content-Length"
+ my $missing = $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) = '';
+ }
+ else {
+ $r->content($buf);
+ $buf='';
+ }
+ }
+ elsif ($ct && $ct =~ m/^multipart\/\w+\s*;.*boundary\s*=\s*("?)(\w+)\1/i) {
+ # Handle multipart content type
+ my $boundary = "$CRLF--$2--";
+ my $index;
+ while (1) {
+ $index = index($buf, $boundary);
+ last if $index >= 0;
+ # end marker not yet found
+ return unless $self->_need_more($buf, $timeout, $fdset);
+ }
+ $index += length($boundary);
+ $r->content(substr($buf, 0, $index));
+ substr($buf, 0, $index) = '';
+
+ }
+ ${*$self}{'httpd_rbuf'} = $buf;
+
+ $r;
+}
+
+
+sub _need_more
+{
+ my $self = shift;
+ #my($buf,$timeout,$fdset) = @_;
+ if ($_[1]) {
+ my($timeout, $fdset) = @_[1,2];
+ print STDERR "select(,,,$timeout)\n" if $DEBUG;
+ my $n = select($fdset,undef,undef,$timeout);
+ unless ($n) {
+ $self->reason(defined($n) ? "Timeout" : "select: $!");
+ return;
+ }
+ }
+ print STDERR "sysread()\n" if $DEBUG;
+ my $n = sysread($self, $_[0], 2048, length($_[0]));
+ $self->reason(defined($n) ? "Client closed" : "sysread: $!") unless $n;
+ $n;
+}
+
+
+sub read_buffer
+{
+ my $self = shift;
+ my $old = ${*$self}{'httpd_rbuf'};
+ if (@_) {
+ ${*$self}{'httpd_rbuf'} = shift;
+ }
+ $old;
+}
+
+
+sub reason
+{
+ my $self = shift;
+ my $old = ${*$self}{'httpd_reason'};
+ if (@_) {
+ ${*$self}{'httpd_reason'} = shift;
+ }
+ $old;
+}
+
+
+sub proto_ge
+{
+ my $self = shift;
+ ${*$self}{'httpd_client_proto'} >= _http_version(shift);
+}
+
+
+sub _http_version
+{
+ local($_) = shift;
+ return 0 unless m,^(?:HTTP/)?(\d+)\.(\d+)$,i;
+ $1 * 1000 + $2;
+}
+
+
+sub antique_client
+{
+ my $self = shift;
+ ${*$self}{'httpd_client_proto'} < $HTTP_1_0;
+}
+
+
+sub force_last_request
+{
+ my $self = shift;
+ ${*$self}{'httpd_nomore'}++;
+}
+
+sub head_request
+{
+ my $self = shift;
+ ${*$self}{'httpd_head'};
+}
+
+
+sub send_status_line
+{
+ my($self, $status, $message, $proto) = @_;
+ return if $self->antique_client;
+ $status ||= RC_OK;
+ $message ||= status_message($status) || "";
+ $proto ||= $HTTP::Daemon::PROTO || "HTTP/1.1";
+ print $self "$proto $status $message$CRLF";
+}
+
+
+sub send_crlf
+{
+ my $self = shift;
+ print $self $CRLF;
+}
+
+
+sub send_basic_header
+{
+ my $self = shift;
+ return if $self->antique_client;
+ $self->send_status_line(@_);
+ print $self "Date: ", time2str(time), $CRLF;
+ my $product = $self->daemon->product_tokens;
+ print $self "Server: $product$CRLF" if $product;
+}
+
+
+sub send_header
+{
+ my $self = shift;
+ while (@_) {
+ my($k, $v) = splice(@_, 0, 2);
+ $v = "" unless defined($v);
+ print $self "$k: $v$CRLF";
+ }
+}
+
+
+sub send_response
+{
+ my $self = shift;
+ my $res = shift;
+ if (!ref $res) {
+ $res ||= RC_OK;
+ $res = HTTP::Response->new($res, @_);
+ }
+ my $content = $res->content;
+ my $chunked;
+ unless ($self->antique_client) {
+ my $code = $res->code;
+ $self->send_basic_header($code, $res->message, $res->protocol);
+ if ($code =~ /^(1\d\d|[23]04)$/) {
+ # make sure content is empty
+ $res->remove_header("Content-Length");
+ $content = "";
+ }
+ elsif ($res->request && $res->request->method eq "HEAD") {
+ # probably OK
+ }
+ elsif (ref($content) eq "CODE") {
+ if ($self->proto_ge("HTTP/1.1")) {
+ $res->push_header("Transfer-Encoding" => "chunked");
+ $chunked++;
+ }
+ else {
+ $self->force_last_request;
+ }
+ }
+ elsif (length($content)) {
+ $res->header("Content-Length" => length($content));
+ }
+ else {
+ $self->force_last_request;
+ $res->header('connection','close');
+ }
+ print $self $res->headers_as_string($CRLF);
+ print $self $CRLF; # separates headers and content
+ }
+ if ($self->head_request) {
+ # no content
+ }
+ elsif (ref($content) eq "CODE") {
+ while (1) {
+ my $chunk = &$content();
+ last unless defined($chunk) && length($chunk);
+ if ($chunked) {
+ printf $self "%x%s%s%s", length($chunk), $CRLF, $chunk, $CRLF;
+ }
+ else {
+ print $self $chunk;
+ }
+ }
+ print $self "0$CRLF$CRLF" if $chunked; # no trailers either
+ }
+ elsif (length $content) {
+ print $self $content;
+ }
+}
+
+
+sub send_redirect
+{
+ my($self, $loc, $status, $content) = @_;
+ $status ||= RC_MOVED_PERMANENTLY;
+ Carp::croak("Status '$status' is not redirect") unless is_redirect($status);
+ $self->send_basic_header($status);
+ my $base = $self->daemon->url;
+ $loc = $HTTP::URI_CLASS->new($loc, $base) unless ref($loc);
+ $loc = $loc->abs($base);
+ print $self "Location: $loc$CRLF";
+ if ($content) {
+ my $ct = $content =~ /^\s*</ ? "text/html" : "text/plain";
+ print $self "Content-Type: $ct$CRLF";
+ }
+ print $self $CRLF;
+ print $self $content if $content && !$self->head_request;
+ $self->force_last_request; # no use keeping the connection open
+}
+
+
+sub send_error
+{
+ my($self, $status, $error) = @_;
+ $status ||= RC_BAD_REQUEST;
+ Carp::croak("Status '$status' is not an error") unless is_error($status);
+ my $mess = status_message($status);
+ $error ||= "";
+ $mess = <<EOT;
+<title>$status $mess</title>
+<h1>$status $mess</h1>
+$error
+EOT
+ unless ($self->antique_client) {
+ $self->send_basic_header($status);
+ print $self "Content-Type: text/html$CRLF";
+ print $self "Content-Length: " . length($mess) . $CRLF;
+ print $self $CRLF;
+ }
+ print $self $mess unless $self->head_request;
+ $status;
+}
+
+
+sub send_file_response
+{
+ my($self, $file) = @_;
+ if (-d $file) {
+ $self->send_dir($file);
+ }
+ elsif (-f _) {
+ # plain file
+ local(*F);
+ sysopen(F, $file, 0) or
+ return $self->send_error(RC_FORBIDDEN);
+ binmode(F);
+ my($ct,$ce) = 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-Length: $size$CRLF" if $size;
+ print $self "Last-Modified: ", time2str($mtime), "$CRLF" if $mtime;
+ print $self $CRLF;
+ }
+ $self->send_file(\*F) unless $self->head_request;
+ return RC_OK;
+ }
+ else {
+ $self->send_error(RC_NOT_FOUND);
+ }
+}
+
+
+sub send_dir
+{
+ my($self, $dir) = @_;
+ $self->send_error(RC_NOT_FOUND) unless -d $dir;
+ $self->send_error(RC_NOT_IMPLEMENTED);
+}
+
+
+sub send_file
+{
+ my($self, $file) = @_;
+ my $opened = 0;
+ local(*FILE);
+ if (!ref($file)) {
+ open(FILE, $file) || return undef;
+ binmode(FILE);
+ $file = \*FILE;
+ $opened++;
+ }
+ my $cnt = 0;
+ my $buf = "";
+ my $n;
+ while ($n = sysread($file, $buf, 8*1024)) {
+ last if !$n;
+ $cnt += $n;
+ print $self $buf;
+ }
+ close($file) if $opened;
+ $cnt;
+}
+
+
+sub daemon
+{
+ my $self = shift;
+ ${*$self}{'httpd_daemon'};
+}
+
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTTP::Daemon - a simple http server class
+
+=head1 SYNOPSIS
+
+ use HTTP::Daemon;
+ use HTTP::Status;
+
+ my $d = HTTP::Daemon->new || die;
+ print "Please contact me at: <URL:", $d->url, ">\n";
+ while (my $c = $d->accept) {
+ while (my $r = $c->get_request) {
+ if ($r->method eq 'GET' and $r->uri->path eq "/xyzzy") {
+ # remember, this is *not* recommended practice :-)
+ $c->send_file_response("/etc/passwd");
+ }
+ else {
+ $c->send_error(RC_FORBIDDEN)
+ }
+ }
+ $c->close;
+ undef($c);
+ }
+
+=head1 DESCRIPTION
+
+Instances of the C<HTTP::Daemon> class are HTTP/1.1 servers that
+listen on a socket for incoming requests. The C<HTTP::Daemon> is a
+subclass of C<IO::Socket::INET>, so you can perform socket operations
+directly on it too.
+
+The accept() method will return when a connection from a client is
+available. The returned value will be an C<HTTP::Daemon::ClientConn>
+object which is another C<IO::Socket::INET> subclass. Calling the
+get_request() method on this object will read data from the client and
+return an C<HTTP::Request> object. The ClientConn object also provide
+methods to send back various responses.
+
+This HTTP daemon does not fork(2) for you. Your application, i.e. the
+user of the C<HTTP::Daemon> is responsible for forking if that is
+desirable. Also note that the user is responsible for generating
+responses that conform to the HTTP/1.1 protocol.
+
+The following methods of C<HTTP::Daemon> are new (or enhanced) relative
+to the C<IO::Socket::INET> base class:
+
+=over 4
+
+=item $d = HTTP::Daemon->new
+
+=item $d = HTTP::Daemon->new( %opts )
+
+The constructor method takes the same arguments as the
+C<IO::Socket::INET> constructor, but unlike its base class it can also
+be called without any arguments. The daemon will then set up a listen
+queue of 5 connections and allocate some random port number.
+
+A server that wants to bind to some specific address on the standard
+HTTP port will be constructed like this:
+
+ $d = HTTP::Daemon->new(
+ LocalAddr => 'www.thisplace.com',
+ LocalPort => 80,
+ );
+
+See L<IO::Socket::INET> for a description of other arguments that can
+be used configure the daemon during construction.
+
+=item $c = $d->accept
+
+=item $c = $d->accept( $pkg )
+
+=item ($c, $peer_addr) = $d->accept
+
+This method works the same the one provided by the base class, but it
+returns an C<HTTP::Daemon::ClientConn> reference by default. If a
+package name is provided as argument, then the returned object will be
+blessed into the given class. It is probably a good idea to make that
+class a subclass of C<HTTP::Daemon::ClientConn>.
+
+The accept method will return C<undef> if timeouts have been enabled
+and no connection is made within the given time. The timeout() method
+is described in L<IO::Socket>.
+
+In list context both the client object and the peer address will be
+returned; see the description of the accept method L<IO::Socket> for
+details.
+
+=item $d->url
+
+Returns a URL string that can be used to access the server root.
+
+=item $d->product_tokens
+
+Returns the name that this server will use to identify itself. This
+is the string that is sent with the C<Server> response header. The
+main reason to have this method is that subclasses can override it if
+they want to use another product name.
+
+The default is the string "libwww-perl-daemon/#.##" where "#.##" is
+replaced with the version number of this module.
+
+=back
+
+The C<HTTP::Daemon::ClientConn> is a C<IO::Socket::INET>
+subclass. Instances of this class are returned by the accept() method
+of C<HTTP::Daemon>. The following methods are provided:
+
+=over 4
+
+=item $c->get_request
+
+=item $c->get_request( $headers_only )
+
+This method reads data from the client and turns it into an
+C<HTTP::Request> object which is returned. It returns C<undef>
+if reading fails. If it fails, then the C<HTTP::Daemon::ClientConn>
+object ($c) should be discarded, and you should not try call this
+method again on it. The $c->reason method might give you some
+information about why $c->get_request failed.
+
+The get_request() method will normally not return until the whole
+request has been received from the client. This might not be what you
+want if the request is an upload of a large file (and with chunked
+transfer encoding HTTP can even support infinite request messages -
+uploading live audio for instance). If you pass a TRUE value as the
+$headers_only argument, then get_request() will return immediately
+after parsing the request headers and you are responsible for reading
+the rest of the request content. If you are going to call
+$c->get_request again on the same connection you better read the
+correct number of bytes.
+
+=item $c->read_buffer
+
+=item $c->read_buffer( $new_value )
+
+Bytes read by $c->get_request, but not used are placed in the I<read
+buffer>. The next time $c->get_request is called it will consume the
+bytes in this buffer before reading more data from the network
+connection itself. The read buffer is invalid after $c->get_request
+has failed.
+
+If you handle the reading of the request content yourself you need to
+empty this buffer before you read more and you need to place
+unconsumed bytes here. You also need this buffer if you implement
+services like I<101 Switching Protocols>.
+
+This method always returns the old buffer content and can optionally
+replace the buffer content if you pass it an argument.
+
+=item $c->reason
+
+When $c->get_request returns C<undef> you can obtain a short string
+describing why it happened by calling $c->reason.
+
+=item $c->proto_ge( $proto )
+
+Return TRUE if the client announced a protocol with version number
+greater or equal to the given argument. The $proto argument can be a
+string like "HTTP/1.1" or just "1.1".
+
+=item $c->antique_client
+
+Return TRUE if the client speaks the HTTP/0.9 protocol. No status
+code and no headers should be returned to such a client. This should
+be the same as !$c->proto_ge("HTTP/1.0").
+
+=item $c->head_request
+
+Return TRUE if the last request was a C<HEAD> request. No content
+body must be generated for these requests.
+
+=item $c->force_last_request
+
+Make sure that $c->get_request will not try to read more requests off
+this connection. If you generate a response that is not self
+delimiting, then you should signal this fact by calling this method.
+
+This attribute is turned on automatically if the client announces
+protocol HTTP/1.0 or worse and does not include a "Connection:
+Keep-Alive" header. It is also turned on automatically when HTTP/1.1
+or better clients send the "Connection: close" request header.
+
+=item $c->send_status_line
+
+=item $c->send_status_line( $code )
+
+=item $c->send_status_line( $code, $mess )
+
+=item $c->send_status_line( $code, $mess, $proto )
+
+Send the status line back to the client. If $code is omitted 200 is
+assumed. If $mess is omitted, then a message corresponding to $code
+is inserted. If $proto is missing the content of the
+$HTTP::Daemon::PROTO variable is used.
+
+=item $c->send_crlf
+
+Send the CRLF sequence to the client.
+
+=item $c->send_basic_header
+
+=item $c->send_basic_header( $code )
+
+=item $c->send_basic_header( $code, $mess )
+
+=item $c->send_basic_header( $code, $mess, $proto )
+
+Send the status line and the "Date:" and "Server:" headers back to
+the client. This header is assumed to be continued and does not end
+with an empty CRLF line.
+
+See the description of send_status_line() for the description of the
+accepted arguments.
+
+=item $c->send_header( $field, $value )
+
+=item $c->send_header( $field1, $value1, $field2, $value2, ... )
+
+Send one or more header lines.
+
+=item $c->send_response( $res )
+
+Write a C<HTTP::Response> object to the
+client as a response. We try hard to make sure that the response is
+self delimiting so that the connection can stay persistent for further
+request/response exchanges.
+
+The content attribute of the C<HTTP::Response> object can be a normal
+string or a subroutine reference. If it is a subroutine, then
+whatever this callback routine returns is written back to the
+client as the response content. The routine will be called until it
+return an undefined or empty value. If the client is HTTP/1.1 aware
+then we will use chunked transfer encoding for the response.
+
+=item $c->send_redirect( $loc )
+
+=item $c->send_redirect( $loc, $code )
+
+=item $c->send_redirect( $loc, $code, $entity_body )
+
+Send a redirect response back to the client. The location ($loc) can
+be an absolute or relative URL. The $code must be one the redirect
+status codes, and defaults to "301 Moved Permanently"
+
+=item $c->send_error
+
+=item $c->send_error( $code )
+
+=item $c->send_error( $code, $error_message )
+
+Send an error response back to the client. If the $code is missing a
+"Bad Request" error is reported. The $error_message is a string that
+is incorporated in the body of the HTML entity body.
+
+=item $c->send_file_response( $filename )
+
+Send back a response with the specified $filename as content. If the
+file is a directory we try to generate an HTML index of it.
+
+=item $c->send_file( $filename )
+
+=item $c->send_file( $fd )
+
+Copy the file to the client. The file can be a string (which
+will be interpreted as a filename) or a reference to an C<IO::Handle>
+or glob.
+
+=item $c->daemon
+
+Return a reference to the corresponding C<HTTP::Daemon> object.
+
+=back
+
+=head1 SEE ALSO
+
+RFC 2616
+
+L<IO::Socket::INET>, L<IO::Socket>
+
+=head1 COPYRIGHT
+
+Copyright 1996-2003, 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/HTTP/Date.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm
new file mode 100644
index 0000000000..d05d21605a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Date.pm
@@ -0,0 +1,388 @@
+package HTTP::Date;
+
+$VERSION = "6.02";
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(time2str str2time);
+@EXPORT_OK = qw(parse_date time2iso time2isoz);
+
+use strict;
+require Time::Local;
+
+use vars qw(@DoW @MoY %MoY);
+@DoW = qw(Sun Mon Tue Wed Thu Fri Sat);
+@MoY = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
+@MoY{@MoY} = (1..12);
+
+my %GMT_ZONE = (GMT => 1, UTC => 1, UT => 1, Z => 1);
+
+
+sub time2str (;$)
+{
+ my $time = shift;
+ $time = time unless defined $time;
+ my ($sec, $min, $hour, $mday, $mon, $year, $wday) = gmtime($time);
+ sprintf("%s, %02d %s %04d %02d:%02d:%02d GMT",
+ $DoW[$wday],
+ $mday, $MoY[$mon], $year+1900,
+ $hour, $min, $sec);
+}
+
+
+sub str2time ($;$)
+{
+ my $str = shift;
+ return undef unless defined $str;
+
+ # fast exit for strictly conforming string
+ if ($str =~ /^[SMTWF][a-z][a-z], (\d\d) ([JFMAJSOND][a-z][a-z]) (\d\d\d\d) (\d\d):(\d\d):(\d\d) GMT$/) {
+ return eval {
+ my $t = Time::Local::timegm($6, $5, $4, $1, $MoY{$2}-1, $3);
+ $t < 0 ? undef : $t;
+ };
+ }
+
+ my @d = parse_date($str);
+ return undef unless @d;
+ $d[1]--; # month
+
+ my $tz = pop(@d);
+ unless (defined $tz) {
+ unless (defined($tz = shift)) {
+ return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac));
+ my $t = Time::Local::timelocal(reverse @d) + $frac;
+ $t < 0 ? undef : $t;
+ };
+ }
+ }
+
+ my $offset = 0;
+ if ($GMT_ZONE{uc $tz}) {
+ # offset already zero
+ }
+ elsif ($tz =~ /^([-+])?(\d\d?):?(\d\d)?$/) {
+ $offset = 3600 * $2;
+ $offset += 60 * $3 if $3;
+ $offset *= -1 if $1 && $1 eq '-';
+ }
+ else {
+ eval { require Time::Zone } || return undef;
+ $offset = Time::Zone::tz_offset($tz);
+ return undef unless defined $offset;
+ }
+
+ return eval { my $frac = $d[-1]; $frac -= ($d[-1] = int($frac));
+ my $t = Time::Local::timegm(reverse @d) + $frac;
+ $t < 0 ? undef : $t - $offset;
+ };
+}
+
+
+sub parse_date ($)
+{
+ local($_) = shift;
+ return unless defined;
+
+ # More lax parsing below
+ s/^\s+//; # kill leading space
+ s/^(?:Sun|Mon|Tue|Wed|Thu|Fri|Sat)[a-z]*,?\s*//i; # Useless weekday
+
+ my($day, $mon, $yr, $hr, $min, $sec, $tz, $ampm);
+
+ # Then we are able to check for most of the formats with this regexp
+ (($day,$mon,$yr,$hr,$min,$sec,$tz) =
+ /^
+ (\d\d?) # day
+ (?:\s+|[-\/])
+ (\w+) # month
+ (?:\s+|[-\/])
+ (\d+) # year
+ (?:
+ (?:\s+|:) # separator before clock
+ (\d\d?):(\d\d) # hour:min
+ (?::(\d\d))? # optional seconds
+ )? # optional clock
+ \s*
+ ([-+]?\d{2,4}|(?![APap][Mm]\b)[A-Za-z]+)? # timezone
+ \s*
+ (?:\(\w+\)|\w{3,})? # ASCII representation of timezone.
+ \s*$
+ /x)
+
+ ||
+
+ # Try the ctime and asctime format
+ (($mon, $day, $hr, $min, $sec, $tz, $yr) =
+ /^
+ (\w{1,3}) # month
+ \s+
+ (\d\d?) # day
+ \s+
+ (\d\d?):(\d\d) # hour:min
+ (?::(\d\d))? # optional seconds
+ \s+
+ (?:([A-Za-z]+)\s+)? # optional timezone
+ (\d+) # year
+ \s*$ # allow trailing whitespace
+ /x)
+
+ ||
+
+ # Then the Unix 'ls -l' date format
+ (($mon, $day, $yr, $hr, $min, $sec) =
+ /^
+ (\w{3}) # month
+ \s+
+ (\d\d?) # day
+ \s+
+ (?:
+ (\d\d\d\d) | # year
+ (\d{1,2}):(\d{2}) # hour:min
+ (?::(\d\d))? # optional seconds
+ )
+ \s*$
+ /x)
+
+ ||
+
+ # ISO 8601 format '1996-02-29 12:00:00 -0100' and variants
+ (($yr, $mon, $day, $hr, $min, $sec, $tz) =
+ /^
+ (\d{4}) # year
+ [-\/]?
+ (\d\d?) # numerical month
+ [-\/]?
+ (\d\d?) # day
+ (?:
+ (?:\s+|[-:Tt]) # separator before clock
+ (\d\d?):?(\d\d) # hour:min
+ (?::?(\d\d(?:\.\d*)?))? # optional seconds (and fractional)
+ )? # optional clock
+ \s*
+ ([-+]?\d\d?:?(:?\d\d)?
+ |Z|z)? # timezone (Z is "zero meridian", i.e. GMT)
+ \s*$
+ /x)
+
+ ||
+
+ # Windows 'dir' 11-12-96 03:52PM
+ (($mon, $day, $yr, $hr, $min, $ampm) =
+ /^
+ (\d{2}) # numerical month
+ -
+ (\d{2}) # day
+ -
+ (\d{2}) # year
+ \s+
+ (\d\d?):(\d\d)([APap][Mm]) # hour:min AM or PM
+ \s*$
+ /x)
+
+ ||
+ return; # unrecognized format
+
+ # Translate month name to number
+ $mon = $MoY{$mon} ||
+ $MoY{"\u\L$mon"} ||
+ ($mon =~ /^\d\d?$/ && $mon >= 1 && $mon <= 12 && int($mon)) ||
+ return;
+
+ # If the year is missing, we assume first date before the current,
+ # because of the formats we support such dates are mostly present
+ # on "ls -l" listings.
+ unless (defined $yr) {
+ my $cur_mon;
+ ($cur_mon, $yr) = (localtime)[4, 5];
+ $yr += 1900;
+ $cur_mon++;
+ $yr-- if $mon > $cur_mon;
+ }
+ elsif (length($yr) < 3) {
+ # Find "obvious" year
+ my $cur_yr = (localtime)[5] + 1900;
+ my $m = $cur_yr % 100;
+ my $tmp = $yr;
+ $yr += $cur_yr - $m;
+ $m -= $tmp;
+ $yr += ($m > 0) ? 100 : -100
+ if abs($m) > 50;
+ }
+
+ # Make sure clock elements are defined
+ $hr = 0 unless defined($hr);
+ $min = 0 unless defined($min);
+ $sec = 0 unless defined($sec);
+
+ # Compensate for AM/PM
+ if ($ampm) {
+ $ampm = uc $ampm;
+ $hr = 0 if $hr == 12 && $ampm eq 'AM';
+ $hr += 12 if $ampm eq 'PM' && $hr != 12;
+ }
+
+ return($yr, $mon, $day, $hr, $min, $sec, $tz)
+ if wantarray;
+
+ if (defined $tz) {
+ $tz = "Z" if $tz =~ /^(GMT|UTC?|[-+]?0+)$/;
+ }
+ else {
+ $tz = "";
+ }
+ return sprintf("%04d-%02d-%02d %02d:%02d:%02d%s",
+ $yr, $mon, $day, $hr, $min, $sec, $tz);
+}
+
+
+sub time2iso (;$)
+{
+ my $time = shift;
+ $time = time unless defined $time;
+ my($sec,$min,$hour,$mday,$mon,$year) = localtime($time);
+ sprintf("%04d-%02d-%02d %02d:%02d:%02d",
+ $year+1900, $mon+1, $mday, $hour, $min, $sec);
+}
+
+
+sub time2isoz (;$)
+{
+ my $time = shift;
+ $time = time unless defined $time;
+ my($sec,$min,$hour,$mday,$mon,$year) = gmtime($time);
+ sprintf("%04d-%02d-%02d %02d:%02d:%02dZ",
+ $year+1900, $mon+1, $mday, $hour, $min, $sec);
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+HTTP::Date - date conversion routines
+
+=head1 SYNOPSIS
+
+ use HTTP::Date;
+
+ $string = time2str($time); # Format as GMT ASCII time
+ $time = str2time($string); # convert ASCII date to machine time
+
+=head1 DESCRIPTION
+
+This module provides functions that deal the date formats used by the
+HTTP protocol (and then some more). Only the first two functions,
+time2str() and str2time(), are exported by default.
+
+=over 4
+
+=item time2str( [$time] )
+
+The time2str() function converts a machine time (seconds since epoch)
+to a string. If the function is called without an argument or with an
+undefined argument, it will use the current time.
+
+The string returned is in the format preferred for the HTTP protocol.
+This is a fixed length subset of the format defined by RFC 1123,
+represented in Universal Time (GMT). An example of a time stamp
+in this format is:
+
+ Sun, 06 Nov 1994 08:49:37 GMT
+
+=item str2time( $str [, $zone] )
+
+The str2time() function converts a string to machine time. It returns
+C<undef> if the format of $str is unrecognized, otherwise whatever the
+C<Time::Local> functions can make out of the parsed time. Dates
+before the system's epoch may not work on all operating systems. The
+time formats recognized are the same as for parse_date().
+
+The function also takes an optional second argument that specifies the
+default time zone to use when converting the date. This parameter is
+ignored if the zone is found in the date string itself. If this
+parameter is missing, and the date string format does not contain any
+zone specification, then the local time zone is assumed.
+
+If the zone is not "C<GMT>" or numerical (like "C<-0800>" or
+"C<+0100>"), then the C<Time::Zone> module must be installed in order
+to get the date recognized.
+
+=item parse_date( $str )
+
+This function will try to parse a date string, and then return it as a
+list of numerical values followed by a (possible undefined) time zone
+specifier; ($year, $month, $day, $hour, $min, $sec, $tz). The $year
+will be the full 4-digit year, and $month numbers start with 1 (for January).
+
+In scalar context the numbers are interpolated in a string of the
+"YYYY-MM-DD hh:mm:ss TZ"-format and returned.
+
+If the date is unrecognized, then the empty list is returned (C<undef> in
+scalar context).
+
+The function is able to parse the following formats:
+
+ "Wed, 09 Feb 1994 22:23:32 GMT" -- HTTP format
+ "Thu Feb 3 17:03:55 GMT 1994" -- ctime(3) format
+ "Thu Feb 3 00:00:00 1994", -- ANSI C asctime() format
+ "Tuesday, 08-Feb-94 14:15:29 GMT" -- old rfc850 HTTP format
+ "Tuesday, 08-Feb-1994 14:15:29 GMT" -- broken rfc850 HTTP format
+
+ "03/Feb/1994:17:03:55 -0700" -- common logfile format
+ "09 Feb 1994 22:23:32 GMT" -- HTTP format (no weekday)
+ "08-Feb-94 14:15:29 GMT" -- rfc850 format (no weekday)
+ "08-Feb-1994 14:15:29 GMT" -- broken rfc850 format (no weekday)
+
+ "1994-02-03 14:15:29 -0100" -- ISO 8601 format
+ "1994-02-03 14:15:29" -- zone is optional
+ "1994-02-03" -- only date
+ "1994-02-03T14:15:29" -- Use T as separator
+ "19940203T141529Z" -- ISO 8601 compact format
+ "19940203" -- only date
+
+ "08-Feb-94" -- old rfc850 HTTP format (no weekday, no time)
+ "08-Feb-1994" -- broken rfc850 HTTP format (no weekday, no time)
+ "09 Feb 1994" -- proposed new HTTP format (no weekday, no time)
+ "03/Feb/1994" -- common logfile format (no time, no offset)
+
+ "Feb 3 1994" -- Unix 'ls -l' format
+ "Feb 3 17:03" -- Unix 'ls -l' format
+
+ "11-15-96 03:52PM" -- Windows 'dir' format
+
+The parser ignores leading and trailing whitespace. It also allow the
+seconds to be missing and the month to be numerical in most formats.
+
+If the year is missing, then we assume that the date is the first
+matching date I<before> current month. If the year is given with only
+2 digits, then parse_date() will select the century that makes the
+year closest to the current date.
+
+=item time2iso( [$time] )
+
+Same as time2str(), but returns a "YYYY-MM-DD hh:mm:ss"-formatted
+string representing time in the local time zone.
+
+=item time2isoz( [$time] )
+
+Same as time2str(), but returns a "YYYY-MM-DD hh:mm:ssZ"-formatted
+string representing Universal Time.
+
+
+=back
+
+=head1 SEE ALSO
+
+L<perlfunc/time>, L<Time::Zone>
+
+=head1 COPYRIGHT
+
+Copyright 1995-1999, 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/HTTP/Headers.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers.pm
new file mode 100644
index 0000000000..1c25c79982
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers.pm
@@ -0,0 +1,890 @@
+package HTTP::Headers;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+use Carp ();
+
+# The $TRANSLATE_UNDERSCORE variable controls whether '_' can be used
+# as a replacement for '-' in header field names.
+our $TRANSLATE_UNDERSCORE = 1 unless defined $TRANSLATE_UNDERSCORE;
+
+# "Good Practice" order of HTTP message headers:
+# - General-Headers
+# - Request-Headers
+# - Response-Headers
+# - Entity-Headers
+
+my @general_headers = qw(
+ Cache-Control Connection Date Pragma Trailer Transfer-Encoding Upgrade
+ Via Warning
+);
+
+my @request_headers = qw(
+ Accept Accept-Charset Accept-Encoding Accept-Language
+ Authorization Expect From Host
+ If-Match If-Modified-Since If-None-Match If-Range If-Unmodified-Since
+ Max-Forwards Proxy-Authorization Range Referer TE User-Agent
+);
+
+my @response_headers = qw(
+ Accept-Ranges Age ETag Location Proxy-Authenticate Retry-After Server
+ Vary WWW-Authenticate
+);
+
+my @entity_headers = qw(
+ Allow Content-Encoding Content-Language Content-Length Content-Location
+ Content-MD5 Content-Range Content-Type Expires Last-Modified
+);
+
+my %entity_header = map { lc($_) => 1 } @entity_headers;
+
+my @header_order = (
+ @general_headers,
+ @request_headers,
+ @response_headers,
+ @entity_headers,
+);
+
+# Make alternative representations of @header_order. This is used
+# for sorting and case matching.
+my %header_order;
+my %standard_case;
+
+{
+ my $i = 0;
+ for (@header_order) {
+ my $lc = lc $_;
+ $header_order{$lc} = ++$i;
+ $standard_case{$lc} = $_;
+ }
+}
+
+
+
+sub new
+{
+ my($class) = shift;
+ my $self = bless {}, $class;
+ $self->header(@_) if @_; # set up initial headers
+ $self;
+}
+
+
+sub header
+{
+ my $self = shift;
+ Carp::croak('Usage: $h->header($field, ...)') unless @_;
+ my(@old);
+ my %seen;
+ while (@_) {
+ my $field = shift;
+ my $op = @_ ? ($seen{lc($field)}++ ? 'PUSH' : 'SET') : 'GET';
+ @old = $self->_header($field, shift, $op);
+ }
+ return @old if wantarray;
+ return $old[0] if @old <= 1;
+ join(", ", @old);
+}
+
+sub clear
+{
+ my $self = shift;
+ %$self = ();
+}
+
+
+sub push_header
+{
+ my $self = shift;
+ return $self->_header(@_, 'PUSH_H') if @_ == 2;
+ while (@_) {
+ $self->_header(splice(@_, 0, 2), 'PUSH_H');
+ }
+}
+
+
+sub init_header
+{
+ Carp::croak('Usage: $h->init_header($field, $val)') if @_ != 3;
+ shift->_header(@_, 'INIT');
+}
+
+
+sub remove_header
+{
+ my($self, @fields) = @_;
+ my $field;
+ my @values;
+ foreach $field (@fields) {
+ $field =~ tr/_/-/ if $field !~ /^:/ && $TRANSLATE_UNDERSCORE;
+ my $v = delete $self->{lc $field};
+ push(@values, ref($v) eq 'ARRAY' ? @$v : $v) if defined $v;
+ }
+ return @values;
+}
+
+sub remove_content_headers
+{
+ my $self = shift;
+ unless (defined(wantarray)) {
+ # fast branch that does not create return object
+ delete @$self{grep $entity_header{$_} || /^content-/, keys %$self};
+ return;
+ }
+
+ my $c = ref($self)->new;
+ for my $f (grep $entity_header{$_} || /^content-/, keys %$self) {
+ $c->{$f} = delete $self->{$f};
+ }
+ if (exists $self->{'::std_case'}) {
+ $c->{'::std_case'} = $self->{'::std_case'};
+ }
+ $c;
+}
+
+
+sub _header
+{
+ my($self, $field, $val, $op) = @_;
+
+ Carp::croak("Illegal field name '$field'")
+ if rindex($field, ':') > 1 || !length($field);
+
+ unless ($field =~ /^:/) {
+ $field =~ tr/_/-/ if $TRANSLATE_UNDERSCORE;
+ my $old = $field;
+ $field = lc $field;
+ unless($standard_case{$field} || $self->{'::std_case'}{$field}) {
+ # generate a %std_case entry for this field
+ $old =~ s/\b(\w)/\u$1/g;
+ $self->{'::std_case'}{$field} = $old;
+ }
+ }
+
+ $op ||= defined($val) ? 'SET' : 'GET';
+ if ($op eq 'PUSH_H') {
+ # Like PUSH but where we don't care about the return value
+ if (exists $self->{$field}) {
+ my $h = $self->{$field};
+ if (ref($h) eq 'ARRAY') {
+ push(@$h, ref($val) eq "ARRAY" ? @$val : $val);
+ }
+ else {
+ $self->{$field} = [$h, ref($val) eq "ARRAY" ? @$val : $val]
+ }
+ return;
+ }
+ $self->{$field} = $val;
+ return;
+ }
+
+ my $h = $self->{$field};
+ my @old = ref($h) eq 'ARRAY' ? @$h : (defined($h) ? ($h) : ());
+
+ unless ($op eq 'GET' || ($op eq 'INIT' && @old)) {
+ if (defined($val)) {
+ my @new = ($op eq 'PUSH') ? @old : ();
+ if (ref($val) ne 'ARRAY') {
+ push(@new, $val);
+ }
+ else {
+ push(@new, @$val);
+ }
+ $self->{$field} = @new > 1 ? \@new : $new[0];
+ }
+ elsif ($op ne 'PUSH') {
+ delete $self->{$field};
+ }
+ }
+ @old;
+}
+
+
+sub _sorted_field_names
+{
+ my $self = shift;
+ return [ sort {
+ ($header_order{$a} || 999) <=> ($header_order{$b} || 999) ||
+ $a cmp $b
+ } grep !/^::/, keys %$self ];
+}
+
+
+sub header_field_names {
+ my $self = shift;
+ return map $standard_case{$_} || $self->{'::std_case'}{$_} || $_, @{ $self->_sorted_field_names },
+ if wantarray;
+ return grep !/^::/, keys %$self;
+}
+
+
+sub scan
+{
+ my($self, $sub) = @_;
+ my $key;
+ for $key (@{ $self->_sorted_field_names }) {
+ my $vals = $self->{$key};
+ if (ref($vals) eq 'ARRAY') {
+ my $val;
+ for $val (@$vals) {
+ $sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $val);
+ }
+ }
+ else {
+ $sub->($standard_case{$key} || $self->{'::std_case'}{$key} || $key, $vals);
+ }
+ }
+}
+
+sub flatten {
+ my($self)=@_;
+
+ (
+ map {
+ my $k = $_;
+ map {
+ ( $k => $_ )
+ } $self->header($_);
+ } $self->header_field_names
+ );
+}
+
+sub as_string
+{
+ my($self, $endl) = @_;
+ $endl = "\n" unless defined $endl;
+
+ my @result = ();
+ for my $key (@{ $self->_sorted_field_names }) {
+ next if index($key, '_') == 0;
+ my $vals = $self->{$key};
+ if ( ref($vals) eq 'ARRAY' ) {
+ for my $val (@$vals) {
+ $val = '' if not defined $val;
+ my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key;
+ $field =~ s/^://;
+ if ( index($val, "\n") >= 0 ) {
+ $val = _process_newline($val, $endl);
+ }
+ push @result, $field . ': ' . $val;
+ }
+ }
+ else {
+ $vals = '' if not defined $vals;
+ my $field = $standard_case{$key} || $self->{'::std_case'}{$key} || $key;
+ $field =~ s/^://;
+ if ( index($vals, "\n") >= 0 ) {
+ $vals = _process_newline($vals, $endl);
+ }
+ push @result, $field . ': ' . $vals;
+ }
+ }
+
+ join($endl, @result, '');
+}
+
+sub _process_newline {
+ local $_ = shift;
+ my $endl = shift;
+ # must handle header values with embedded newlines with care
+ s/\s+$//; # trailing newlines and space must go
+ s/\n(\x0d?\n)+/\n/g; # no empty lines
+ s/\n([^\040\t])/\n $1/g; # initial space for continuation
+ s/\n/$endl/g; # substitute with requested line ending
+ $_;
+}
+
+
+
+if (eval { require Storable; 1 }) {
+ *clone = \&Storable::dclone;
+} else {
+ *clone = sub {
+ my $self = shift;
+ my $clone = HTTP::Headers->new;
+ $self->scan(sub { $clone->push_header(@_);} );
+ $clone;
+ };
+}
+
+
+sub _date_header
+{
+ require HTTP::Date;
+ my($self, $header, $time) = @_;
+ my($old) = $self->_header($header);
+ if (defined $time) {
+ $self->_header($header, HTTP::Date::time2str($time));
+ }
+ $old =~ s/;.*// if defined($old);
+ HTTP::Date::str2time($old);
+}
+
+
+sub date { shift->_date_header('Date', @_); }
+sub expires { shift->_date_header('Expires', @_); }
+sub if_modified_since { shift->_date_header('If-Modified-Since', @_); }
+sub if_unmodified_since { shift->_date_header('If-Unmodified-Since', @_); }
+sub last_modified { shift->_date_header('Last-Modified', @_); }
+
+# This is used as a private LWP extension. The Client-Date header is
+# added as a timestamp to a response when it has been received.
+sub client_date { shift->_date_header('Client-Date', @_); }
+
+# The retry_after field is dual format (can also be a expressed as
+# number of seconds from now), so we don't provide an easy way to
+# access it until we have know how both these interfaces can be
+# addressed. One possibility is to return a negative value for
+# relative seconds and a positive value for epoch based time values.
+#sub retry_after { shift->_date_header('Retry-After', @_); }
+
+sub content_type {
+ my $self = shift;
+ my $ct = $self->{'content-type'};
+ $self->{'content-type'} = shift if @_;
+ $ct = $ct->[0] if ref($ct) eq 'ARRAY';
+ return '' unless defined($ct) && length($ct);
+ my @ct = split(/;\s*/, $ct, 2);
+ for ($ct[0]) {
+ s/\s+//g;
+ $_ = lc($_);
+ }
+ wantarray ? @ct : $ct[0];
+}
+
+sub content_type_charset {
+ my $self = shift;
+ require HTTP::Headers::Util;
+ my $h = $self->{'content-type'};
+ $h = $h->[0] if ref($h);
+ $h = "" unless defined $h;
+ my @v = HTTP::Headers::Util::split_header_words($h);
+ if (@v) {
+ my($ct, undef, %ct_param) = @{$v[0]};
+ my $charset = $ct_param{charset};
+ if ($ct) {
+ $ct = lc($ct);
+ $ct =~ s/\s+//;
+ }
+ if ($charset) {
+ $charset = uc($charset);
+ $charset =~ s/^\s+//; $charset =~ s/\s+\z//;
+ undef($charset) if $charset eq "";
+ }
+ return $ct, $charset if wantarray;
+ return $charset;
+ }
+ return undef, undef if wantarray;
+ return undef;
+}
+
+sub content_is_text {
+ my $self = shift;
+ return $self->content_type =~ m,^text/,;
+}
+
+sub content_is_html {
+ my $self = shift;
+ return $self->content_type eq 'text/html' || $self->content_is_xhtml;
+}
+
+sub content_is_xhtml {
+ my $ct = shift->content_type;
+ return $ct eq "application/xhtml+xml" ||
+ $ct eq "application/vnd.wap.xhtml+xml";
+}
+
+sub content_is_xml {
+ my $ct = shift->content_type;
+ return 1 if $ct eq "text/xml";
+ return 1 if $ct eq "application/xml";
+ return 1 if $ct =~ /\+xml$/;
+ return 0;
+}
+
+sub referer {
+ my $self = shift;
+ if (@_ && $_[0] =~ /#/) {
+ # Strip fragment per RFC 2616, section 14.36.
+ my $uri = shift;
+ if (ref($uri)) {
+ $uri = $uri->clone;
+ $uri->fragment(undef);
+ }
+ else {
+ $uri =~ s/\#.*//;
+ }
+ unshift @_, $uri;
+ }
+ ($self->_header('Referer', @_))[0];
+}
+*referrer = \&referer; # on tchrist's request
+
+sub title { (shift->_header('Title', @_))[0] }
+sub content_encoding { (shift->_header('Content-Encoding', @_))[0] }
+sub content_language { (shift->_header('Content-Language', @_))[0] }
+sub content_length { (shift->_header('Content-Length', @_))[0] }
+
+sub user_agent { (shift->_header('User-Agent', @_))[0] }
+sub server { (shift->_header('Server', @_))[0] }
+
+sub from { (shift->_header('From', @_))[0] }
+sub warning { (shift->_header('Warning', @_))[0] }
+
+sub www_authenticate { (shift->_header('WWW-Authenticate', @_))[0] }
+sub authorization { (shift->_header('Authorization', @_))[0] }
+
+sub proxy_authenticate { (shift->_header('Proxy-Authenticate', @_))[0] }
+sub proxy_authorization { (shift->_header('Proxy-Authorization', @_))[0] }
+
+sub authorization_basic { shift->_basic_auth("Authorization", @_) }
+sub proxy_authorization_basic { shift->_basic_auth("Proxy-Authorization", @_) }
+
+sub _basic_auth {
+ require MIME::Base64;
+ my($self, $h, $user, $passwd) = @_;
+ my($old) = $self->_header($h);
+ if (defined $user) {
+ Carp::croak("Basic authorization user name can't contain ':'")
+ if $user =~ /:/;
+ $passwd = '' unless defined $passwd;
+ $self->_header($h => 'Basic ' .
+ MIME::Base64::encode("$user:$passwd", ''));
+ }
+ if (defined $old && $old =~ s/^\s*Basic\s+//) {
+ my $val = MIME::Base64::decode($old);
+ return $val unless wantarray;
+ return split(/:/, $val, 2);
+ }
+ return;
+}
+
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Headers - Class encapsulating HTTP Message headers
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ require HTTP::Headers;
+ $h = HTTP::Headers->new;
+
+ $h->header('Content-Type' => 'text/plain'); # set
+ $ct = $h->header('Content-Type'); # get
+ $h->remove_header('Content-Type'); # delete
+
+=head1 DESCRIPTION
+
+The C<HTTP::Headers> class encapsulates HTTP-style message headers.
+The headers consist of attribute-value pairs also called fields, which
+may be repeated, and which are printed in a particular order. The
+field names are cases insensitive.
+
+Instances of this class are usually created as member variables of the
+C<HTTP::Request> and C<HTTP::Response> classes, internal to the
+library.
+
+The following methods are available:
+
+=over 4
+
+=item $h = HTTP::Headers->new
+
+Constructs a new C<HTTP::Headers> object. You might pass some initial
+attribute-value pairs as parameters to the constructor. I<E.g.>:
+
+ $h = HTTP::Headers->new(
+ Date => 'Thu, 03 Feb 1994 00:00:00 GMT',
+ Content_Type => 'text/html; version=3.2',
+ Content_Base => 'http://www.perl.org/');
+
+The constructor arguments are passed to the C<header> method which is
+described below.
+
+=item $h->clone
+
+Returns a copy of this C<HTTP::Headers> object.
+
+=item $h->header( $field )
+
+=item $h->header( $field => $value )
+
+=item $h->header( $f1 => $v1, $f2 => $v2, ... )
+
+Get or set the value of one or more header fields. The header field
+name ($field) is not case sensitive. To make the life easier for perl
+users who wants to avoid quoting before the => operator, you can use
+'_' as a replacement for '-' in header names.
+
+The header() method accepts multiple ($field => $value) pairs, which
+means that you can update several fields with a single invocation.
+
+The $value argument may be a plain string or a reference to an array
+of strings for a multi-valued field. If the $value is provided as
+C<undef> then the field is removed. If the $value is not given, then
+that header field will remain unchanged.
+
+The old value (or values) of the last of the header fields is returned.
+If no such field exists C<undef> will be returned.
+
+A multi-valued field will be returned as separate values in list
+context and will be concatenated with ", " as separator in scalar
+context. The HTTP spec (RFC 2616) promises that joining multiple
+values in this way will not change the semantic of a header field, but
+in practice there are cases like old-style Netscape cookies (see
+L<HTTP::Cookies>) where "," is used as part of the syntax of a single
+field value.
+
+Examples:
+
+ $header->header(MIME_Version => '1.0',
+ User_Agent => 'My-Web-Client/0.01');
+ $header->header(Accept => "text/html, text/plain, image/*");
+ $header->header(Accept => [qw(text/html text/plain image/*)]);
+ @accepts = $header->header('Accept'); # get multiple values
+ $accepts = $header->header('Accept'); # get values as a single string
+
+=item $h->push_header( $field => $value )
+
+=item $h->push_header( $f1 => $v1, $f2 => $v2, ... )
+
+Add a new field value for the specified header field. Previous values
+for the same field are retained.
+
+As for the header() method, the field name ($field) is not case
+sensitive and '_' can be used as a replacement for '-'.
+
+The $value argument may be a scalar or a reference to a list of
+scalars.
+
+ $header->push_header(Accept => 'image/jpeg');
+ $header->push_header(Accept => [map "image/$_", qw(gif png tiff)]);
+
+=item $h->init_header( $field => $value )
+
+Set the specified header to the given value, but only if no previous
+value for that field is set.
+
+The header field name ($field) is not case sensitive and '_'
+can be used as a replacement for '-'.
+
+The $value argument may be a scalar or a reference to a list of
+scalars.
+
+=item $h->remove_header( $field, ... )
+
+This function removes the header fields with the specified names.
+
+The header field names ($field) are not case sensitive and '_'
+can be used as a replacement for '-'.
+
+The return value is the values of the fields removed. In scalar
+context the number of fields removed is returned.
+
+Note that if you pass in multiple field names then it is generally not
+possible to tell which of the returned values belonged to which field.
+
+=item $h->remove_content_headers
+
+This will remove all the header fields used to describe the content of
+a message. All header field names prefixed with C<Content-> fall
+into this category, as well as C<Allow>, C<Expires> and
+C<Last-Modified>. RFC 2616 denotes these fields as I<Entity Header
+Fields>.
+
+The return value is a new C<HTTP::Headers> object that contains the
+removed headers only.
+
+=item $h->clear
+
+This will remove all header fields.
+
+=item $h->header_field_names
+
+Returns the list of distinct names for the fields present in the
+header. The field names have case as suggested by HTTP spec, and the
+names are returned in the recommended "Good Practice" order.
+
+In scalar context return the number of distinct field names.
+
+=item $h->scan( \&process_header_field )
+
+Apply a subroutine to each header field in turn. The callback routine
+is called with two parameters; the name of the field and a single
+value (a string). If a header field is multi-valued, then the
+routine is called once for each value. The field name passed to the
+callback routine has case as suggested by HTTP spec, and the headers
+will be visited in the recommended "Good Practice" order.
+
+Any return values of the callback routine are ignored. The loop can
+be broken by raising an exception (C<die>), but the caller of scan()
+would have to trap the exception itself.
+
+=item $h->flatten()
+
+Returns the list of pairs of keys and values.
+
+=item $h->as_string
+
+=item $h->as_string( $eol )
+
+Return the header fields as a formatted MIME header. Since it
+internally uses the C<scan> method to build the string, the result
+will use case as suggested by HTTP spec, and it will follow
+recommended "Good Practice" of ordering the header fields. Long header
+values are not folded.
+
+The optional $eol parameter specifies the line ending sequence to
+use. The default is "\n". Embedded "\n" characters in header field
+values will be substituted with this line ending sequence.
+
+=back
+
+=head1 CONVENIENCE METHODS
+
+The most frequently used headers can also be accessed through the
+following convenience methods. Most of these methods can both be used to read
+and to set the value of a header. The header value is set if you pass
+an argument to the method. The old header value is always returned.
+If the given header did not exist then C<undef> is returned.
+
+Methods that deal with dates/times always convert their value to system
+time (seconds since Jan 1, 1970) and they also expect this kind of
+value when the header value is set.
+
+=over 4
+
+=item $h->date
+
+This header represents the date and time at which the message was
+originated. I<E.g.>:
+
+ $h->date(time); # set current date
+
+=item $h->expires
+
+This header gives the date and time after which the entity should be
+considered stale.
+
+=item $h->if_modified_since
+
+=item $h->if_unmodified_since
+
+These header fields are used to make a request conditional. If the requested
+resource has (or has not) been modified since the time specified in this field,
+then the server will return a C<304 Not Modified> response instead of
+the document itself.
+
+=item $h->last_modified
+
+This header indicates the date and time at which the resource was last
+modified. I<E.g.>:
+
+ # check if document is more than 1 hour old
+ if (my $last_mod = $h->last_modified) {
+ if ($last_mod < time - 60*60) {
+ ...
+ }
+ }
+
+=item $h->content_type
+
+The Content-Type header field indicates the media type of the message
+content. I<E.g.>:
+
+ $h->content_type('text/html');
+
+The value returned will be converted to lower case, and potential
+parameters will be chopped off and returned as a separate value if in
+an array context. If there is no such header field, then the empty
+string is returned. This makes it safe to do the following:
+
+ if ($h->content_type eq 'text/html') {
+ # we enter this place even if the real header value happens to
+ # be 'TEXT/HTML; version=3.0'
+ ...
+ }
+
+=item $h->content_type_charset
+
+Returns the upper-cased charset specified in the Content-Type header. In list
+context return the lower-cased bare content type followed by the upper-cased
+charset. Both values will be C<undef> if not specified in the header.
+
+=item $h->content_is_text
+
+Returns TRUE if the Content-Type header field indicate that the
+content is textual.
+
+=item $h->content_is_html
+
+Returns TRUE if the Content-Type header field indicate that the
+content is some kind of HTML (including XHTML). This method can't be
+used to set Content-Type.
+
+=item $h->content_is_xhtml
+
+Returns TRUE if the Content-Type header field indicate that the
+content is XHTML. This method can't be used to set Content-Type.
+
+=item $h->content_is_xml
+
+Returns TRUE if the Content-Type header field indicate that the
+content is XML. This method can't be used to set Content-Type.
+
+=item $h->content_encoding
+
+The Content-Encoding header field is used as a modifier to the
+media type. When present, its value indicates what additional
+encoding mechanism has been applied to the resource.
+
+=item $h->content_length
+
+A decimal number indicating the size in bytes of the message content.
+
+=item $h->content_language
+
+The natural language(s) of the intended audience for the message
+content. The value is one or more language tags as defined by RFC
+1766. Eg. "no" for some kind of Norwegian and "en-US" for English the
+way it is written in the US.
+
+=item $h->title
+
+The title of the document. In libwww-perl this header will be
+initialized automatically from the E<lt>TITLE>...E<lt>/TITLE> element
+of HTML documents. I<This header is no longer part of the HTTP
+standard.>
+
+=item $h->user_agent
+
+This header field is used in request messages and contains information
+about the user agent originating the request. I<E.g.>:
+
+ $h->user_agent('Mozilla/5.0 (compatible; MSIE 7.0; Windows NT 6.0)');
+
+=item $h->server
+
+The server header field contains information about the software being
+used by the originating server program handling the request.
+
+=item $h->from
+
+This header should contain an Internet e-mail address for the human
+user who controls the requesting user agent. The address should be
+machine-usable, as defined by RFC822. E.g.:
+
+ $h->from('King Kong <king@kong.com>');
+
+I<This header is no longer part of the HTTP standard.>
+
+=item $h->referer
+
+Used to specify the address (URI) of the document from which the
+requested resource address was obtained.
+
+The "Free On-line Dictionary of Computing" as this to say about the
+word I<referer>:
+
+ <World-Wide Web> A misspelling of "referrer" which
+ somehow made it into the {HTTP} standard. A given {web
+ page}'s referer (sic) is the {URL} of whatever web page
+ contains the link that the user followed to the current
+ page. Most browsers pass this information as part of a
+ request.
+
+ (1998-10-19)
+
+By popular demand C<referrer> exists as an alias for this method so you
+can avoid this misspelling in your programs and still send the right
+thing on the wire.
+
+When setting the referrer, this method removes the fragment from the
+given URI if it is present, as mandated by RFC2616. Note that
+the removal does I<not> happen automatically if using the header(),
+push_header() or init_header() methods to set the referrer.
+
+=item $h->www_authenticate
+
+This header must be included as part of a C<401 Unauthorized> response.
+The field value consist of a challenge that indicates the
+authentication scheme and parameters applicable to the requested URI.
+
+=item $h->proxy_authenticate
+
+This header must be included in a C<407 Proxy Authentication Required>
+response.
+
+=item $h->authorization
+
+=item $h->proxy_authorization
+
+A user agent that wishes to authenticate itself with a server or a
+proxy, may do so by including these headers.
+
+=item $h->authorization_basic
+
+This method is used to get or set an authorization header that use the
+"Basic Authentication Scheme". In array context it will return two
+values; the user name and the password. In scalar context it will
+return I<"uname:password"> as a single string value.
+
+When used to set the header value, it expects two arguments. I<E.g.>:
+
+ $h->authorization_basic($uname, $password);
+
+The method will croak if the $uname contains a colon ':'.
+
+=item $h->proxy_authorization_basic
+
+Same as authorization_basic() but will set the "Proxy-Authorization"
+header instead.
+
+=back
+
+=head1 NON-CANONICALIZED FIELD NAMES
+
+The header field name spelling is normally canonicalized including the
+'_' to '-' translation. There are some application where this is not
+appropriate. Prefixing field names with ':' allow you to force a
+specific spelling. For example if you really want a header field name
+to show up as C<foo_bar> instead of "Foo-Bar", you might set it like
+this:
+
+ $h->header(":foo_bar" => 1);
+
+These field names are returned with the ':' intact for
+$h->header_field_names and the $h->scan callback, but the colons do
+not show in $h->as_string.
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
+
+__END__
+
+
+#ABSTRACT: Class encapsulating HTTP Message headers
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/Auth.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/Auth.pm
new file mode 100644
index 0000000000..462cf628da
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/Auth.pm
@@ -0,0 +1,127 @@
+package HTTP::Headers::Auth;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+use HTTP::Headers;
+
+package
+ HTTP::Headers;
+
+BEGIN {
+ # we provide a new (and better) implementations below
+ undef(&www_authenticate);
+ undef(&proxy_authenticate);
+}
+
+require HTTP::Headers::Util;
+
+sub _parse_authenticate
+{
+ my @ret;
+ for (HTTP::Headers::Util::split_header_words(@_)) {
+ if (!defined($_->[1])) {
+ # this is a new auth scheme
+ push(@ret, shift(@$_) => {});
+ shift @$_;
+ }
+ if (@ret) {
+ # this a new parameter pair for the last auth scheme
+ while (@$_) {
+ my $k = shift @$_;
+ my $v = shift @$_;
+ $ret[-1]{$k} = $v;
+ }
+ }
+ else {
+ # something wrong, parameter pair without any scheme seen
+ # IGNORE
+ }
+ }
+ @ret;
+}
+
+sub _authenticate
+{
+ my $self = shift;
+ my $header = shift;
+ my @old = $self->_header($header);
+ if (@_) {
+ $self->remove_header($header);
+ my @new = @_;
+ while (@new) {
+ my $a_scheme = shift(@new);
+ if ($a_scheme =~ /\s/) {
+ # assume complete valid value, pass it through
+ $self->push_header($header, $a_scheme);
+ }
+ else {
+ my @param;
+ if (@new) {
+ my $p = $new[0];
+ if (ref($p) eq "ARRAY") {
+ @param = @$p;
+ shift(@new);
+ }
+ elsif (ref($p) eq "HASH") {
+ @param = %$p;
+ shift(@new);
+ }
+ }
+ my $val = ucfirst(lc($a_scheme));
+ if (@param) {
+ my $sep = " ";
+ while (@param) {
+ my $k = shift @param;
+ my $v = shift @param;
+ if ($v =~ /[^0-9a-zA-Z]/ || lc($k) eq "realm") {
+ # must quote the value
+ $v =~ s,([\\\"]),\\$1,g;
+ $v = qq("$v");
+ }
+ $val .= "$sep$k=$v";
+ $sep = ", ";
+ }
+ }
+ $self->push_header($header, $val);
+ }
+ }
+ }
+ return unless defined wantarray;
+ wantarray ? _parse_authenticate(@old) : join(", ", @old);
+}
+
+
+sub www_authenticate { shift->_authenticate("WWW-Authenticate", @_) }
+sub proxy_authenticate { shift->_authenticate("Proxy-Authenticate", @_) }
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Headers::Auth
+
+=head1 VERSION
+
+version 6.18
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/ETag.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/ETag.pm
new file mode 100644
index 0000000000..02d6249b06
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/ETag.pm
@@ -0,0 +1,123 @@
+package HTTP::Headers::ETag;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+require HTTP::Date;
+
+require HTTP::Headers;
+package
+ HTTP::Headers;
+
+sub _etags
+{
+ my $self = shift;
+ my $header = shift;
+ my @old = _split_etag_list($self->_header($header));
+ if (@_) {
+ $self->_header($header => join(", ", _split_etag_list(@_)));
+ }
+ wantarray ? @old : join(", ", @old);
+}
+
+sub etag { shift->_etags("ETag", @_); }
+sub if_match { shift->_etags("If-Match", @_); }
+sub if_none_match { shift->_etags("If-None-Match", @_); }
+
+sub if_range {
+ # Either a date or an entity-tag
+ my $self = shift;
+ my @old = $self->_header("If-Range");
+ if (@_) {
+ my $new = shift;
+ if (!defined $new) {
+ $self->remove_header("If-Range");
+ }
+ elsif ($new =~ /^\d+$/) {
+ $self->_date_header("If-Range", $new);
+ }
+ else {
+ $self->_etags("If-Range", $new);
+ }
+ }
+ return unless defined(wantarray);
+ for (@old) {
+ my $t = HTTP::Date::str2time($_);
+ $_ = $t if $t;
+ }
+ wantarray ? @old : join(", ", @old);
+}
+
+
+# Split a list of entity tag values. The return value is a list
+# consisting of one element per entity tag. Suitable for parsing
+# headers like C<If-Match>, C<If-None-Match>. You might even want to
+# use it on C<ETag> and C<If-Range> entity tag values, because it will
+# normalize them to the common form.
+#
+# entity-tag = [ weak ] opaque-tag
+# weak = "W/"
+# opaque-tag = quoted-string
+
+
+sub _split_etag_list
+{
+ my(@val) = @_;
+ my @res;
+ for (@val) {
+ while (length) {
+ my $weak = "";
+ $weak = "W/" if s,^\s*[wW]/,,;
+ my $etag = "";
+ if (s/^\s*(\"[^\"\\]*(?:\\.[^\"\\]*)*\")//) {
+ push(@res, "$weak$1");
+ }
+ elsif (s/^\s*,//) {
+ push(@res, qq(W/"")) if $weak;
+ }
+ elsif (s/^\s*([^,\s]+)//) {
+ $etag = $1;
+ $etag =~ s/([\"\\])/\\$1/g;
+ push(@res, qq($weak"$etag"));
+ }
+ elsif (s/^\s+// || !length) {
+ push(@res, qq(W/"")) if $weak;
+ }
+ else {
+ die "This should not happen: '$_'";
+ }
+ }
+ }
+ @res;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Headers::ETag
+
+=head1 VERSION
+
+version 6.18
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/Util.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/Util.pm
new file mode 100644
index 0000000000..dc07eb32ad
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Headers/Util.pm
@@ -0,0 +1,213 @@
+package HTTP::Headers::Util;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+use base 'Exporter';
+
+our @EXPORT_OK=qw(split_header_words _split_header_words join_header_words);
+
+
+sub split_header_words {
+ my @res = &_split_header_words;
+ for my $arr (@res) {
+ for (my $i = @$arr - 2; $i >= 0; $i -= 2) {
+ $arr->[$i] = lc($arr->[$i]);
+ }
+ }
+ return @res;
+}
+
+sub _split_header_words
+{
+ my(@val) = @_;
+ my @res;
+ for (@val) {
+ my @cur;
+ while (length) {
+ if (s/^\s*(=*[^\s=;,]+)//) { # 'token' or parameter 'attribute'
+ push(@cur, $1);
+ # a quoted value
+ if (s/^\s*=\s*\"([^\"\\]*(?:\\.[^\"\\]*)*)\"//) {
+ my $val = $1;
+ $val =~ s/\\(.)/$1/g;
+ push(@cur, $val);
+ # some unquoted value
+ }
+ elsif (s/^\s*=\s*([^;,\s]*)//) {
+ my $val = $1;
+ $val =~ s/\s+$//;
+ push(@cur, $val);
+ # no value, a lone token
+ }
+ else {
+ push(@cur, undef);
+ }
+ }
+ elsif (s/^\s*,//) {
+ push(@res, [@cur]) if @cur;
+ @cur = ();
+ }
+ elsif (s/^\s*;// || s/^\s+//) {
+ # continue
+ }
+ else {
+ die "This should not happen: '$_'";
+ }
+ }
+ push(@res, \@cur) if @cur;
+ }
+ @res;
+}
+
+
+sub join_header_words
+{
+ @_ = ([@_]) if @_ && !ref($_[0]);
+ my @res;
+ for (@_) {
+ my @cur = @$_;
+ my @attr;
+ while (@cur) {
+ my $k = shift @cur;
+ my $v = shift @cur;
+ if (defined $v) {
+ if ($v =~ /[\x00-\x20()<>@,;:\\\"\/\[\]?={}\x7F-\xFF]/ || !length($v)) {
+ $v =~ s/([\"\\])/\\$1/g; # escape " and \
+ $k .= qq(="$v");
+ }
+ else {
+ # token
+ $k .= "=$v";
+ }
+ }
+ push(@attr, $k);
+ }
+ push(@res, join("; ", @attr)) if @attr;
+ }
+ join(", ", @res);
+}
+
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Headers::Util - Header value parsing utility functions
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ use HTTP::Headers::Util qw(split_header_words);
+ @values = split_header_words($h->header("Content-Type"));
+
+=head1 DESCRIPTION
+
+This module provides a few functions that helps parsing and
+construction of valid HTTP header values. None of the functions are
+exported by default.
+
+The following functions are available:
+
+=over 4
+
+=item split_header_words( @header_values )
+
+This function will parse the header values given as argument into a
+list of anonymous arrays containing key/value pairs. The function
+knows how to deal with ",", ";" and "=" as well as quoted values after
+"=". A list of space separated tokens are parsed as if they were
+separated by ";".
+
+If the @header_values passed as argument contains multiple values,
+then they are treated as if they were a single value separated by
+comma ",".
+
+This means that this function is useful for parsing header fields that
+follow this syntax (BNF as from the HTTP/1.1 specification, but we relax
+the requirement for tokens).
+
+ headers = #header
+ header = (token | parameter) *( [";"] (token | parameter))
+
+ token = 1*<any CHAR except CTLs or separators>
+ separators = "(" | ")" | "<" | ">" | "@"
+ | "," | ";" | ":" | "\" | <">
+ | "/" | "[" | "]" | "?" | "="
+ | "{" | "}" | SP | HT
+
+ quoted-string = ( <"> *(qdtext | quoted-pair ) <"> )
+ qdtext = <any TEXT except <">>
+ quoted-pair = "\" CHAR
+
+ parameter = attribute "=" value
+ attribute = token
+ value = token | quoted-string
+
+Each I<header> is represented by an anonymous array of key/value
+pairs. The keys will be all be forced to lower case.
+The value for a simple token (not part of a parameter) is C<undef>.
+Syntactically incorrect headers will not necessarily be parsed as you
+would want.
+
+This is easier to describe with some examples:
+
+ split_header_words('foo="bar"; port="80,81"; DISCARD, BAR=baz');
+ split_header_words('text/html; charset="iso-8859-1"');
+ split_header_words('Basic realm="\\"foo\\\\bar\\""');
+
+will return
+
+ [foo=>'bar', port=>'80,81', discard=> undef], [bar=>'baz' ]
+ ['text/html' => undef, charset => 'iso-8859-1']
+ [basic => undef, realm => "\"foo\\bar\""]
+
+If you don't want the function to convert tokens and attribute keys to
+lower case you can call it as C<_split_header_words> instead (with a
+leading underscore).
+
+=item join_header_words( @arrays )
+
+This will do the opposite of the conversion done by split_header_words().
+It takes a list of anonymous arrays as arguments (or a list of
+key/value pairs) and produces a single header value. Attribute values
+are quoted if needed.
+
+Example:
+
+ join_header_words(["text/plain" => undef, charset => "iso-8859/1"]);
+ join_header_words("text/plain" => undef, charset => "iso-8859/1");
+
+will both return the string:
+
+ text/plain; charset="iso-8859/1"
+
+=back
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
+
+__END__
+
+
+#ABSTRACT: Header value parsing utility functions
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Message.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Message.pm
new file mode 100644
index 0000000000..078209e8ed
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Message.pm
@@ -0,0 +1,1133 @@
+package HTTP::Message;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+require HTTP::Headers;
+require Carp;
+
+my $CRLF = "\015\012"; # "\r\n" is not portable
+unless ($HTTP::URI_CLASS) {
+ if ($ENV{PERL_HTTP_URI_CLASS}
+ && $ENV{PERL_HTTP_URI_CLASS} =~ /^([\w:]+)$/) {
+ $HTTP::URI_CLASS = $1;
+ } else {
+ $HTTP::URI_CLASS = "URI";
+ }
+}
+eval "require $HTTP::URI_CLASS"; die $@ if $@;
+
+*_utf8_downgrade = defined(&utf8::downgrade) ?
+ sub {
+ utf8::downgrade($_[0], 1) or
+ Carp::croak("HTTP::Message content must be bytes")
+ }
+ :
+ sub {
+ };
+
+sub new
+{
+ my($class, $header, $content) = @_;
+ if (defined $header) {
+ Carp::croak("Bad header argument") unless ref $header;
+ if (ref($header) eq "ARRAY") {
+ $header = HTTP::Headers->new(@$header);
+ }
+ else {
+ $header = $header->clone;
+ }
+ }
+ else {
+ $header = HTTP::Headers->new;
+ }
+ if (defined $content) {
+ _utf8_downgrade($content);
+ }
+ else {
+ $content = '';
+ }
+
+ bless {
+ '_headers' => $header,
+ '_content' => $content,
+ }, $class;
+}
+
+
+sub parse
+{
+ my($class, $str) = @_;
+
+ my @hdr;
+ while (1) {
+ if ($str =~ s/^([^\s:]+)[ \t]*: ?(.*)\n?//) {
+ push(@hdr, $1, $2);
+ $hdr[-1] =~ s/\r\z//;
+ }
+ elsif (@hdr && $str =~ s/^([ \t].*)\n?//) {
+ $hdr[-1] .= "\n$1";
+ $hdr[-1] =~ s/\r\z//;
+ }
+ else {
+ $str =~ s/^\r?\n//;
+ last;
+ }
+ }
+ local $HTTP::Headers::TRANSLATE_UNDERSCORE;
+ new($class, \@hdr, $str);
+}
+
+
+sub clone
+{
+ my $self = shift;
+ my $clone = HTTP::Message->new($self->headers,
+ $self->content);
+ $clone->protocol($self->protocol);
+ $clone;
+}
+
+
+sub clear {
+ my $self = shift;
+ $self->{_headers}->clear;
+ $self->content("");
+ delete $self->{_parts};
+ return;
+}
+
+
+sub protocol {
+ shift->_elem('_protocol', @_);
+}
+
+sub headers {
+ my $self = shift;
+
+ # recalculation of _content might change headers, so we
+ # need to force it now
+ $self->_content unless exists $self->{_content};
+
+ $self->{_headers};
+}
+
+sub headers_as_string {
+ shift->headers->as_string(@_);
+}
+
+
+sub content {
+
+ my $self = $_[0];
+ if (defined(wantarray)) {
+ $self->_content unless exists $self->{_content};
+ my $old = $self->{_content};
+ $old = $$old if ref($old) eq "SCALAR";
+ &_set_content if @_ > 1;
+ return $old;
+ }
+
+ if (@_ > 1) {
+ &_set_content;
+ }
+ else {
+ Carp::carp("Useless content call in void context") if $^W;
+ }
+}
+
+
+sub _set_content {
+ my $self = $_[0];
+ _utf8_downgrade($_[1]);
+ if (!ref($_[1]) && ref($self->{_content}) eq "SCALAR") {
+ ${$self->{_content}} = defined( $_[1] ) ? $_[1] : '';
+ }
+ else {
+ die "Can't set content to be a scalar reference" if ref($_[1]) eq "SCALAR";
+ $self->{_content} = defined( $_[1] ) ? $_[1] : '';
+ delete $self->{_content_ref};
+ }
+ delete $self->{_parts} unless $_[2];
+}
+
+
+sub add_content
+{
+ my $self = shift;
+ $self->_content unless exists $self->{_content};
+ my $chunkref = \$_[0];
+ $chunkref = $$chunkref if ref($$chunkref); # legacy
+
+ _utf8_downgrade($$chunkref);
+
+ my $ref = ref($self->{_content});
+ if (!$ref) {
+ $self->{_content} .= $$chunkref;
+ }
+ elsif ($ref eq "SCALAR") {
+ ${$self->{_content}} .= $$chunkref;
+ }
+ else {
+ Carp::croak("Can't append to $ref content");
+ }
+ delete $self->{_parts};
+}
+
+sub add_content_utf8 {
+ my($self, $buf) = @_;
+ utf8::upgrade($buf);
+ utf8::encode($buf);
+ $self->add_content($buf);
+}
+
+sub content_ref
+{
+ my $self = shift;
+ $self->_content unless exists $self->{_content};
+ delete $self->{_parts};
+ my $old = \$self->{_content};
+ my $old_cref = $self->{_content_ref};
+ if (@_) {
+ my $new = shift;
+ Carp::croak("Setting content_ref to a non-ref") unless ref($new);
+ delete $self->{_content}; # avoid modifying $$old
+ $self->{_content} = $new;
+ $self->{_content_ref}++;
+ }
+ $old = $$old if $old_cref;
+ return $old;
+}
+
+
+sub content_charset
+{
+ my $self = shift;
+ if (my $charset = $self->content_type_charset) {
+ return $charset;
+ }
+
+ # time to start guessing
+ my $cref = $self->decoded_content(ref => 1, charset => "none");
+
+ # Unicode BOM
+ for ($$cref) {
+ return "UTF-8" if /^\xEF\xBB\xBF/;
+ return "UTF-32LE" if /^\xFF\xFE\x00\x00/;
+ return "UTF-32BE" if /^\x00\x00\xFE\xFF/;
+ return "UTF-16LE" if /^\xFF\xFE/;
+ return "UTF-16BE" if /^\xFE\xFF/;
+ }
+
+ if ($self->content_is_xml) {
+ # http://www.w3.org/TR/2006/REC-xml-20060816/#sec-guessing
+ # XML entity not accompanied by external encoding information and not
+ # in UTF-8 or UTF-16 encoding must begin with an XML encoding declaration,
+ # in which the first characters must be '<?xml'
+ for ($$cref) {
+ return "UTF-32BE" if /^\x00\x00\x00</;
+ return "UTF-32LE" if /^<\x00\x00\x00/;
+ return "UTF-16BE" if /^(?:\x00\s)*\x00</;
+ return "UTF-16LE" if /^(?:\s\x00)*<\x00/;
+ if (/^\s*(<\?xml[^\x00]*?\?>)/) {
+ if ($1 =~ /\sencoding\s*=\s*(["'])(.*?)\1/) {
+ my $enc = $2;
+ $enc =~ s/^\s+//; $enc =~ s/\s+\z//;
+ return $enc if $enc;
+ }
+ }
+ }
+ return "UTF-8";
+ }
+ elsif ($self->content_is_html) {
+ # look for <META charset="..."> or <META content="...">
+ # http://dev.w3.org/html5/spec/Overview.html#determining-the-character-encoding
+ require IO::HTML;
+ # Use relaxed search to match previous versions of HTTP::Message:
+ my $encoding = IO::HTML::find_charset_in($$cref, { encoding => 1,
+ need_pragma => 0 });
+ return $encoding->mime_name if $encoding;
+ }
+ elsif ($self->content_type eq "application/json") {
+ for ($$cref) {
+ # RFC 4627, ch 3
+ return "UTF-32BE" if /^\x00\x00\x00./s;
+ return "UTF-32LE" if /^.\x00\x00\x00/s;
+ return "UTF-16BE" if /^\x00.\x00./s;
+ return "UTF-16LE" if /^.\x00.\x00/s;
+ return "UTF-8";
+ }
+ }
+ if ($self->content_type =~ /^text\//) {
+ for ($$cref) {
+ if (length) {
+ return "US-ASCII" unless /[\x80-\xFF]/;
+ require Encode;
+ eval {
+ Encode::decode_utf8($_, Encode::FB_CROAK() | Encode::LEAVE_SRC());
+ };
+ return "UTF-8" unless $@;
+ return "ISO-8859-1";
+ }
+ }
+ }
+
+ return undef;
+}
+
+
+sub decoded_content
+{
+ my($self, %opt) = @_;
+ my $content_ref;
+ my $content_ref_iscopy;
+
+ eval {
+ $content_ref = $self->content_ref;
+ die "Can't decode ref content" if ref($content_ref) ne "SCALAR";
+
+ if (my $h = $self->header("Content-Encoding")) {
+ $h =~ s/^\s+//;
+ $h =~ s/\s+$//;
+ for my $ce (reverse split(/\s*,\s*/, lc($h))) {
+ next unless $ce;
+ next if $ce eq "identity" || $ce eq "none";
+ if ($ce eq "gzip" || $ce eq "x-gzip") {
+ require IO::Uncompress::Gunzip;
+ my $output;
+ IO::Uncompress::Gunzip::gunzip($content_ref, \$output, Transparent => 0)
+ or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError";
+ $content_ref = \$output;
+ $content_ref_iscopy++;
+ }
+ elsif ($ce eq "x-bzip2" or $ce eq "bzip2") {
+ require IO::Uncompress::Bunzip2;
+ my $output;
+ IO::Uncompress::Bunzip2::bunzip2($content_ref, \$output, Transparent => 0)
+ or die "Can't bunzip content: $IO::Uncompress::Bunzip2::Bunzip2Error";
+ $content_ref = \$output;
+ $content_ref_iscopy++;
+ }
+ elsif ($ce eq "deflate") {
+ require IO::Uncompress::Inflate;
+ my $output;
+ my $status = IO::Uncompress::Inflate::inflate($content_ref, \$output, Transparent => 0);
+ my $error = $IO::Uncompress::Inflate::InflateError;
+ unless ($status) {
+ # "Content-Encoding: deflate" is supposed to mean the
+ # "zlib" format of RFC 1950, but Microsoft got that
+ # wrong, so some servers sends the raw compressed
+ # "deflate" data. This tries to inflate this format.
+ $output = undef;
+ require IO::Uncompress::RawInflate;
+ unless (IO::Uncompress::RawInflate::rawinflate($content_ref, \$output)) {
+ $self->push_header("Client-Warning" =>
+ "Could not raw inflate content: $IO::Uncompress::RawInflate::RawInflateError");
+ $output = undef;
+ }
+ }
+ die "Can't inflate content: $error" unless defined $output;
+ $content_ref = \$output;
+ $content_ref_iscopy++;
+ }
+ elsif ($ce eq "compress" || $ce eq "x-compress") {
+ die "Can't uncompress content";
+ }
+ elsif ($ce eq "base64") { # not really C-T-E, but should be harmless
+ require MIME::Base64;
+ $content_ref = \MIME::Base64::decode($$content_ref);
+ $content_ref_iscopy++;
+ }
+ elsif ($ce eq "quoted-printable") { # not really C-T-E, but should be harmless
+ require MIME::QuotedPrint;
+ $content_ref = \MIME::QuotedPrint::decode($$content_ref);
+ $content_ref_iscopy++;
+ }
+ else {
+ die "Don't know how to decode Content-Encoding '$ce'";
+ }
+ }
+ }
+
+ if ($self->content_is_text || (my $is_xml = $self->content_is_xml)) {
+ my $charset = lc(
+ $opt{charset} ||
+ $self->content_type_charset ||
+ $opt{default_charset} ||
+ $self->content_charset ||
+ "ISO-8859-1"
+ );
+ if ($charset eq "none") {
+ # leave it as is
+ }
+ elsif ($charset eq "us-ascii" || $charset eq "iso-8859-1") {
+ if ($$content_ref =~ /[^\x00-\x7F]/ && defined &utf8::upgrade) {
+ unless ($content_ref_iscopy) {
+ my $copy = $$content_ref;
+ $content_ref = \$copy;
+ $content_ref_iscopy++;
+ }
+ utf8::upgrade($$content_ref);
+ }
+ }
+ else {
+ require Encode;
+ eval {
+ $content_ref = \Encode::decode($charset, $$content_ref,
+ ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC());
+ };
+ if ($@) {
+ my $retried;
+ if ($@ =~ /^Unknown encoding/) {
+ my $alt_charset = lc($opt{alt_charset} || "");
+ if ($alt_charset && $charset ne $alt_charset) {
+ # Retry decoding with the alternative charset
+ $content_ref = \Encode::decode($alt_charset, $$content_ref,
+ ($opt{charset_strict} ? Encode::FB_CROAK() : 0) | Encode::LEAVE_SRC())
+ unless $alt_charset eq "none";
+ $retried++;
+ }
+ }
+ die unless $retried;
+ }
+ die "Encode::decode() returned undef improperly" unless defined $$content_ref;
+ if ($is_xml) {
+ # Get rid of the XML encoding declaration if present
+ $$content_ref =~ s/^\x{FEFF}//;
+ if ($$content_ref =~ /^(\s*<\?xml[^\x00]*?\?>)/) {
+ substr($$content_ref, 0, length($1)) =~ s/\sencoding\s*=\s*(["']).*?\1//;
+ }
+ }
+ }
+ }
+ };
+ if ($@) {
+ Carp::croak($@) if $opt{raise_error};
+ return undef;
+ }
+
+ return $opt{ref} ? $content_ref : $$content_ref;
+}
+
+
+sub decodable
+{
+ # should match the Content-Encoding values that decoded_content can deal with
+ my $self = shift;
+ my @enc;
+ # XXX preferably we should determine if the modules are available without loading
+ # them here
+ eval {
+ require IO::Uncompress::Gunzip;
+ push(@enc, "gzip", "x-gzip");
+ };
+ eval {
+ require IO::Uncompress::Inflate;
+ require IO::Uncompress::RawInflate;
+ push(@enc, "deflate");
+ };
+ eval {
+ require IO::Uncompress::Bunzip2;
+ push(@enc, "x-bzip2", "bzip2");
+ };
+ # we don't care about announcing the 'identity', 'base64' and
+ # 'quoted-printable' stuff
+ return wantarray ? @enc : join(", ", @enc);
+}
+
+
+sub decode
+{
+ my $self = shift;
+ return 1 unless $self->header("Content-Encoding");
+ if (defined(my $content = $self->decoded_content(charset => "none"))) {
+ $self->remove_header("Content-Encoding", "Content-Length", "Content-MD5");
+ $self->content($content);
+ return 1;
+ }
+ return 0;
+}
+
+
+sub encode
+{
+ my($self, @enc) = @_;
+
+ Carp::croak("Can't encode multipart/* messages") if $self->content_type =~ m,^multipart/,;
+ Carp::croak("Can't encode message/* messages") if $self->content_type =~ m,^message/,;
+
+ return 1 unless @enc; # nothing to do
+
+ my $content = $self->content;
+ for my $encoding (@enc) {
+ if ($encoding eq "identity" || $encoding eq "none") {
+ # nothing to do
+ }
+ elsif ($encoding eq "base64") {
+ require MIME::Base64;
+ $content = MIME::Base64::encode($content);
+ }
+ elsif ($encoding eq "gzip" || $encoding eq "x-gzip") {
+ require IO::Compress::Gzip;
+ my $output;
+ IO::Compress::Gzip::gzip(\$content, \$output, Minimal => 1)
+ or die "Can't gzip content: $IO::Compress::Gzip::GzipError";
+ $content = $output;
+ }
+ elsif ($encoding eq "deflate") {
+ require IO::Compress::Deflate;
+ my $output;
+ IO::Compress::Deflate::deflate(\$content, \$output)
+ or die "Can't deflate content: $IO::Compress::Deflate::DeflateError";
+ $content = $output;
+ }
+ elsif ($encoding eq "x-bzip2" || $encoding eq "bzip2") {
+ require IO::Compress::Bzip2;
+ my $output;
+ IO::Compress::Bzip2::bzip2(\$content, \$output)
+ or die "Can't bzip2 content: $IO::Compress::Bzip2::Bzip2Error";
+ $content = $output;
+ }
+ elsif ($encoding eq "rot13") { # for the fun of it
+ $content =~ tr/A-Za-z/N-ZA-Mn-za-m/;
+ }
+ else {
+ return 0;
+ }
+ }
+ my $h = $self->header("Content-Encoding");
+ unshift(@enc, $h) if $h;
+ $self->header("Content-Encoding", join(", ", @enc));
+ $self->remove_header("Content-Length", "Content-MD5");
+ $self->content($content);
+ return 1;
+}
+
+
+sub as_string
+{
+ my($self, $eol) = @_;
+ $eol = "\n" unless defined $eol;
+
+ # The calculation of content might update the headers
+ # so we need to do that first.
+ my $content = $self->content;
+
+ return join("", $self->{'_headers'}->as_string($eol),
+ $eol,
+ $content,
+ (@_ == 1 && length($content) &&
+ $content !~ /\n\z/) ? "\n" : "",
+ );
+}
+
+
+sub dump
+{
+ my($self, %opt) = @_;
+ my $content = $self->content;
+ my $chopped = 0;
+ if (!ref($content)) {
+ my $maxlen = $opt{maxlength};
+ $maxlen = 512 unless defined($maxlen);
+ if ($maxlen && length($content) > $maxlen * 1.1 + 3) {
+ $chopped = length($content) - $maxlen;
+ $content = substr($content, 0, $maxlen) . "...";
+ }
+
+ $content =~ s/\\/\\\\/g;
+ $content =~ s/\t/\\t/g;
+ $content =~ s/\r/\\r/g;
+
+ # no need for 3 digits in escape for these
+ $content =~ s/([\0-\11\13-\037])(?!\d)/sprintf('\\%o',ord($1))/eg;
+
+ $content =~ s/([\0-\11\13-\037\177-\377])/sprintf('\\x%02X',ord($1))/eg;
+ $content =~ s/([^\12\040-\176])/sprintf('\\x{%X}',ord($1))/eg;
+
+ # remaining whitespace
+ $content =~ s/( +)\n/("\\40" x length($1)) . "\n"/eg;
+ $content =~ s/(\n+)\n/("\\n" x length($1)) . "\n"/eg;
+ $content =~ s/\n\z/\\n/;
+
+ my $no_content = $opt{no_content};
+ $no_content = "(no content)" unless defined $no_content;
+ if ($content eq $no_content) {
+ # escape our $no_content marker
+ $content =~ s/^(.)/sprintf('\\x%02X',ord($1))/eg;
+ }
+ elsif ($content eq "") {
+ $content = $no_content;
+ }
+ }
+
+ my @dump;
+ push(@dump, $opt{preheader}) if $opt{preheader};
+ push(@dump, $self->{_headers}->as_string, $content);
+ push(@dump, "(+ $chopped more bytes not shown)") if $chopped;
+
+ my $dump = join("\n", @dump, "");
+ $dump =~ s/^/$opt{prefix}/gm if $opt{prefix};
+
+ print $dump unless defined wantarray;
+ return $dump;
+}
+
+# allow subclasses to override what will handle individual parts
+sub _part_class {
+ return __PACKAGE__;
+}
+
+sub parts {
+ my $self = shift;
+ if (defined(wantarray) && (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR")) {
+ $self->_parts;
+ }
+ my $old = $self->{_parts};
+ if (@_) {
+ my @parts = map { ref($_) eq 'ARRAY' ? @$_ : $_ } @_;
+ my $ct = $self->content_type || "";
+ if ($ct =~ m,^message/,) {
+ Carp::croak("Only one part allowed for $ct content")
+ if @parts > 1;
+ }
+ elsif ($ct !~ m,^multipart/,) {
+ $self->remove_content_headers;
+ $self->content_type("multipart/mixed");
+ }
+ $self->{_parts} = \@parts;
+ _stale_content($self);
+ }
+ return @$old if wantarray;
+ return $old->[0];
+}
+
+sub add_part {
+ my $self = shift;
+ if (($self->content_type || "") !~ m,^multipart/,) {
+ my $p = $self->_part_class->new(
+ $self->remove_content_headers,
+ $self->content(""),
+ );
+ $self->content_type("multipart/mixed");
+ $self->{_parts} = [];
+ if ($p->headers->header_field_names || $p->content ne "") {
+ push(@{$self->{_parts}}, $p);
+ }
+ }
+ elsif (!exists $self->{_parts} || ref($self->{_content}) eq "SCALAR") {
+ $self->_parts;
+ }
+
+ push(@{$self->{_parts}}, @_);
+ _stale_content($self);
+ return;
+}
+
+sub _stale_content {
+ my $self = shift;
+ if (ref($self->{_content}) eq "SCALAR") {
+ # must recalculate now
+ $self->_content;
+ }
+ else {
+ # just invalidate cache
+ delete $self->{_content};
+ delete $self->{_content_ref};
+ }
+}
+
+
+# delegate all other method calls to the headers object.
+our $AUTOLOAD;
+sub AUTOLOAD
+{
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
+
+ # We create the function here so that it will not need to be
+ # autoloaded the next time.
+ no strict 'refs';
+ *$method = sub { local $Carp::Internal{+__PACKAGE__} = 1; shift->headers->$method(@_) };
+ goto &$method;
+}
+
+
+sub DESTROY {} # avoid AUTOLOADing it
+
+
+# Private method to access members in %$self
+sub _elem
+{
+ my $self = shift;
+ my $elem = shift;
+ my $old = $self->{$elem};
+ $self->{$elem} = $_[0] if @_;
+ return $old;
+}
+
+
+# Create private _parts attribute from current _content
+sub _parts {
+ my $self = shift;
+ my $ct = $self->content_type;
+ if ($ct =~ m,^multipart/,) {
+ require HTTP::Headers::Util;
+ my @h = HTTP::Headers::Util::split_header_words($self->header("Content-Type"));
+ die "Assert" unless @h;
+ my %h = @{$h[0]};
+ if (defined(my $b = $h{boundary})) {
+ my $str = $self->content;
+ $str =~ s/\r?\n--\Q$b\E--.*//s;
+ if ($str =~ s/(^|.*?\r?\n)--\Q$b\E\r?\n//s) {
+ $self->{_parts} = [map $self->_part_class->parse($_),
+ split(/\r?\n--\Q$b\E\r?\n/, $str)]
+ }
+ }
+ }
+ elsif ($ct eq "message/http") {
+ require HTTP::Request;
+ require HTTP::Response;
+ my $content = $self->content;
+ my $class = ($content =~ m,^(HTTP/.*)\n,) ?
+ "HTTP::Response" : "HTTP::Request";
+ $self->{_parts} = [$class->parse($content)];
+ }
+ elsif ($ct =~ m,^message/,) {
+ $self->{_parts} = [ $self->_part_class->parse($self->content) ];
+ }
+
+ $self->{_parts} ||= [];
+}
+
+
+# Create private _content attribute from current _parts
+sub _content {
+ my $self = shift;
+ my $ct = $self->{_headers}->header("Content-Type") || "multipart/mixed";
+ if ($ct =~ m,^\s*message/,i) {
+ _set_content($self, $self->{_parts}[0]->as_string($CRLF), 1);
+ return;
+ }
+
+ require HTTP::Headers::Util;
+ my @v = HTTP::Headers::Util::split_header_words($ct);
+ Carp::carp("Multiple Content-Type headers") if @v > 1;
+ @v = @{$v[0]};
+
+ my $boundary;
+ my $boundary_index;
+ for (my @tmp = @v; @tmp;) {
+ my($k, $v) = splice(@tmp, 0, 2);
+ if ($k eq "boundary") {
+ $boundary = $v;
+ $boundary_index = @v - @tmp - 1;
+ last;
+ }
+ }
+
+ my @parts = map $_->as_string($CRLF), @{$self->{_parts}};
+
+ my $bno = 0;
+ $boundary = _boundary() unless defined $boundary;
+ CHECK_BOUNDARY:
+ {
+ for (@parts) {
+ if (index($_, $boundary) >= 0) {
+ # must have a better boundary
+ $boundary = _boundary(++$bno);
+ redo CHECK_BOUNDARY;
+ }
+ }
+ }
+
+ if ($boundary_index) {
+ $v[$boundary_index] = $boundary;
+ }
+ else {
+ push(@v, boundary => $boundary);
+ }
+
+ $ct = HTTP::Headers::Util::join_header_words(@v);
+ $self->{_headers}->header("Content-Type", $ct);
+
+ _set_content($self, "--$boundary$CRLF" .
+ join("$CRLF--$boundary$CRLF", @parts) .
+ "$CRLF--$boundary--$CRLF",
+ 1);
+}
+
+
+sub _boundary
+{
+ my $size = shift || return "xYzZY";
+ require MIME::Base64;
+ my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
+ $b =~ s/[\W]/X/g; # ensure alnum only
+ $b;
+}
+
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Message - HTTP style message (base class)
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ use base 'HTTP::Message';
+
+=head1 DESCRIPTION
+
+An C<HTTP::Message> object contains some headers and a content body.
+The following methods are available:
+
+=over 4
+
+=item $mess = HTTP::Message->new
+
+=item $mess = HTTP::Message->new( $headers )
+
+=item $mess = HTTP::Message->new( $headers, $content )
+
+This constructs a new message object. Normally you would want
+construct C<HTTP::Request> or C<HTTP::Response> objects instead.
+
+The optional $header argument should be a reference to an
+C<HTTP::Headers> object or a plain array reference of key/value pairs.
+If an C<HTTP::Headers> object is provided then a copy of it will be
+embedded into the constructed message, i.e. it will not be owned and
+can be modified afterwards without affecting the message.
+
+The optional $content argument should be a string of bytes.
+
+=item $mess = HTTP::Message->parse( $str )
+
+This constructs a new message object by parsing the given string.
+
+=item $mess->headers
+
+Returns the embedded C<HTTP::Headers> object.
+
+=item $mess->headers_as_string
+
+=item $mess->headers_as_string( $eol )
+
+Call the as_string() method for the headers in the
+message. This will be the same as
+
+ $mess->headers->as_string
+
+but it will make your program a whole character shorter :-)
+
+=item $mess->content
+
+=item $mess->content( $bytes )
+
+The content() method sets the raw content if an argument is given. If no
+argument is given the content is not touched. In either case the
+original raw content is returned.
+
+If the C<undef> argument is given, the content is reset to its default value,
+which is an empty string.
+
+Note that the content should be a string of bytes. Strings in perl
+can contain characters outside the range of a byte. The C<Encode>
+module can be used to turn such strings into a string of bytes.
+
+=item $mess->add_content( $bytes )
+
+The add_content() methods appends more data bytes to the end of the
+current content buffer.
+
+=item $mess->add_content_utf8( $string )
+
+The add_content_utf8() method appends the UTF-8 bytes representing the
+string to the end of the current content buffer.
+
+=item $mess->content_ref
+
+=item $mess->content_ref( \$bytes )
+
+The content_ref() method will return a reference to content buffer string.
+It can be more efficient to access the content this way if the content
+is huge, and it can even be used for direct manipulation of the content,
+for instance:
+
+ ${$res->content_ref} =~ s/\bfoo\b/bar/g;
+
+This example would modify the content buffer in-place.
+
+If an argument is passed it will setup the content to reference some
+external source. The content() and add_content() methods
+will automatically dereference scalar references passed this way. For
+other references content() will return the reference itself and
+add_content() will refuse to do anything.
+
+=item $mess->content_charset
+
+This returns the charset used by the content in the message. The
+charset is either found as the charset attribute of the
+C<Content-Type> header or by guessing.
+
+See L<http://www.w3.org/TR/REC-html40/charset.html#spec-char-encoding>
+for details about how charset is determined.
+
+=item $mess->decoded_content( %options )
+
+Returns the content with any C<Content-Encoding> undone and for textual content
+the raw content encoded to Perl's Unicode strings. If the C<Content-Encoding>
+or C<charset> of the message is unknown this method will fail by returning
+C<undef>.
+
+The following options can be specified.
+
+=over
+
+=item C<charset>
+
+This override the charset parameter for text content. The value
+C<none> can used to suppress decoding of the charset.
+
+=item C<default_charset>
+
+This override the default charset guessed by content_charset() or
+if that fails "ISO-8859-1".
+
+=item C<alt_charset>
+
+If decoding fails because the charset specified in the Content-Type header
+isn't recognized by Perl's Encode module, then try decoding using this charset
+instead of failing. The C<alt_charset> might be specified as C<none> to simply
+return the string without any decoding of charset as alternative.
+
+=item C<charset_strict>
+
+Abort decoding if malformed characters is found in the content. By
+default you get the substitution character ("\x{FFFD}") in place of
+malformed characters.
+
+=item C<raise_error>
+
+If TRUE then raise an exception if not able to decode content. Reason
+might be that the specified C<Content-Encoding> or C<charset> is not
+supported. If this option is FALSE, then decoded_content() will return
+C<undef> on errors, but will still set $@.
+
+=item C<ref>
+
+If TRUE then a reference to decoded content is returned. This might
+be more efficient in cases where the decoded content is identical to
+the raw content as no data copying is required in this case.
+
+=back
+
+=item $mess->decodable
+
+=item HTTP::Message::decodable()
+
+This returns the encoding identifiers that decoded_content() can
+process. In scalar context returns a comma separated string of
+identifiers.
+
+This value is suitable for initializing the C<Accept-Encoding> request
+header field.
+
+=item $mess->decode
+
+This method tries to replace the content of the message with the
+decoded version and removes the C<Content-Encoding> header. Returns
+TRUE if successful and FALSE if not.
+
+If the message does not have a C<Content-Encoding> header this method
+does nothing and returns TRUE.
+
+Note that the content of the message is still bytes after this method
+has been called and you still need to call decoded_content() if you
+want to process its content as a string.
+
+=item $mess->encode( $encoding, ... )
+
+Apply the given encodings to the content of the message. Returns TRUE
+if successful. The "identity" (non-)encoding is always supported; other
+currently supported encodings, subject to availability of required
+additional modules, are "gzip", "deflate", "x-bzip2" and "base64".
+
+A successful call to this function will set the C<Content-Encoding>
+header.
+
+Note that C<multipart/*> or C<message/*> messages can't be encoded and
+this method will croak if you try.
+
+=item $mess->parts
+
+=item $mess->parts( @parts )
+
+=item $mess->parts( \@parts )
+
+Messages can be composite, i.e. contain other messages. The composite
+messages have a content type of C<multipart/*> or C<message/*>. This
+method give access to the contained messages.
+
+The argumentless form will return a list of C<HTTP::Message> objects.
+If the content type of $msg is not C<multipart/*> or C<message/*> then
+this will return the empty list. In scalar context only the first
+object is returned. The returned message parts should be regarded as
+read-only (future versions of this library might make it possible
+to modify the parent by modifying the parts).
+
+If the content type of $msg is C<message/*> then there will only be
+one part returned.
+
+If the content type is C<message/http>, then the return value will be
+either an C<HTTP::Request> or an C<HTTP::Response> object.
+
+If a @parts argument is given, then the content of the message will be
+modified. The array reference form is provided so that an empty list
+can be provided. The @parts array should contain C<HTTP::Message>
+objects. The @parts objects are owned by $mess after this call and
+should not be modified or made part of other messages.
+
+When updating the message with this method and the old content type of
+$mess is not C<multipart/*> or C<message/*>, then the content type is
+set to C<multipart/mixed> and all other content headers are cleared.
+
+This method will croak if the content type is C<message/*> and more
+than one part is provided.
+
+=item $mess->add_part( $part )
+
+This will add a part to a message. The $part argument should be
+another C<HTTP::Message> object. If the previous content type of
+$mess is not C<multipart/*> then the old content (together with all
+content headers) will be made part #1 and the content type made
+C<multipart/mixed> before the new part is added. The $part object is
+owned by $mess after this call and should not be modified or made part
+of other messages.
+
+There is no return value.
+
+=item $mess->clear
+
+Will clear the headers and set the content to the empty string. There
+is no return value
+
+=item $mess->protocol
+
+=item $mess->protocol( $proto )
+
+Sets the HTTP protocol used for the message. The protocol() is a string
+like C<HTTP/1.0> or C<HTTP/1.1>.
+
+=item $mess->clone
+
+Returns a copy of the message object.
+
+=item $mess->as_string
+
+=item $mess->as_string( $eol )
+
+Returns the message formatted as a single string.
+
+The optional $eol parameter specifies the line ending sequence to use.
+The default is "\n". If no $eol is given then as_string will ensure
+that the returned string is newline terminated (even when the message
+content is not). No extra newline is appended if an explicit $eol is
+passed.
+
+=item $mess->dump( %opt )
+
+Returns the message formatted as a string. In void context print the string.
+
+This differs from C<< $mess->as_string >> in that it escapes the bytes
+of the content so that it's safe to print them and it limits how much
+content to print. The escapes syntax used is the same as for Perl's
+double quoted strings. If there is no content the string "(no
+content)" is shown in its place.
+
+Options to influence the output can be passed as key/value pairs. The
+following options are recognized:
+
+=over
+
+=item maxlength => $num
+
+How much of the content to show. The default is 512. Set this to 0
+for unlimited.
+
+If the content is longer then the string is chopped at the limit and
+the string "...\n(### more bytes not shown)" appended.
+
+=item no_content => $str
+
+Replaces the "(no content)" marker.
+
+=item prefix => $str
+
+A string that will be prefixed to each line of the dump.
+
+=back
+
+=back
+
+All methods unknown to C<HTTP::Message> itself are delegated to the
+C<HTTP::Headers> object that is part of every message. This allows
+convenient access to these methods. Refer to L<HTTP::Headers> for
+details of these methods:
+
+ $mess->header( $field => $val )
+ $mess->push_header( $field => $val )
+ $mess->init_header( $field => $val )
+ $mess->remove_header( $field )
+ $mess->remove_content_headers
+ $mess->header_field_names
+ $mess->scan( \&doit )
+
+ $mess->date
+ $mess->expires
+ $mess->if_modified_since
+ $mess->if_unmodified_since
+ $mess->last_modified
+ $mess->content_type
+ $mess->content_encoding
+ $mess->content_length
+ $mess->content_language
+ $mess->title
+ $mess->user_agent
+ $mess->server
+ $mess->from
+ $mess->referer
+ $mess->www_authenticate
+ $mess->authorization
+ $mess->proxy_authorization
+ $mess->authorization_basic
+ $mess->proxy_authorization_basic
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
+
+__END__
+
+
+#ABSTRACT: HTTP style message (base class)
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Negotiate.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Negotiate.pm
new file mode 100644
index 0000000000..d293ce86d9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Negotiate.pm
@@ -0,0 +1,528 @@
+package HTTP::Negotiate;
+
+$VERSION = "6.01";
+sub Version { $VERSION; }
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(choose);
+
+require HTTP::Headers;
+
+$DEBUG = 0;
+
+sub choose ($;$)
+{
+ my($variants, $request) = @_;
+ my(%accept);
+
+ unless (defined $request) {
+ # Create a request object from the CGI environment variables
+ $request = HTTP::Headers->new;
+ $request->header('Accept', $ENV{HTTP_ACCEPT})
+ if $ENV{HTTP_ACCEPT};
+ $request->header('Accept-Charset', $ENV{HTTP_ACCEPT_CHARSET})
+ if $ENV{HTTP_ACCEPT_CHARSET};
+ $request->header('Accept-Encoding', $ENV{HTTP_ACCEPT_ENCODING})
+ if $ENV{HTTP_ACCEPT_ENCODING};
+ $request->header('Accept-Language', $ENV{HTTP_ACCEPT_LANGUAGE})
+ if $ENV{HTTP_ACCEPT_LANGUAGE};
+ }
+
+ # Get all Accept values from the request. Build a hash initialized
+ # like this:
+ #
+ # %accept = ( type => { 'audio/*' => { q => 0.2, mbx => 20000 },
+ # 'audio/basic' => { q => 1 },
+ # },
+ # language => { 'no' => { q => 1 },
+ # }
+ # );
+
+ $request->scan(sub {
+ my($key, $val) = @_;
+
+ my $type;
+ if ($key =~ s/^Accept-//) {
+ $type = lc($key);
+ }
+ elsif ($key eq "Accept") {
+ $type = "type";
+ }
+ else {
+ return;
+ }
+
+ $val =~ s/\s+//g;
+ my $default_q = 1;
+ for my $name (split(/,/, $val)) {
+ my(%param, $param);
+ if ($name =~ s/;(.*)//) {
+ for $param (split(/;/, $1)) {
+ my ($pk, $pv) = split(/=/, $param, 2);
+ $param{lc $pk} = $pv;
+ }
+ }
+ $name = lc $name;
+ if (defined $param{'q'}) {
+ $param{'q'} = 1 if $param{'q'} > 1;
+ $param{'q'} = 0 if $param{'q'} < 0;
+ }
+ else {
+ $param{'q'} = $default_q;
+
+ # This makes sure that the first ones are slightly better off
+ # and therefore more likely to be chosen.
+ $default_q -= 0.0001;
+ }
+ $accept{$type}{$name} = \%param;
+ }
+ });
+
+ # Check if any of the variants specify a language. We do this
+ # because it influences how we treat those without (they default to
+ # 0.5 instead of 1).
+ my $any_lang = 0;
+ for $var (@$variants) {
+ if ($var->[5]) {
+ $any_lang = 1;
+ last;
+ }
+ }
+
+ if ($DEBUG) {
+ print "Negotiation parameters in the request\n";
+ for $type (keys %accept) {
+ print " $type:\n";
+ for $name (keys %{$accept{$type}}) {
+ print " $name\n";
+ for $pv (keys %{$accept{$type}{$name}}) {
+ print " $pv = $accept{$type}{$name}{$pv}\n";
+ }
+ }
+ }
+ }
+
+ my @Q = (); # This is where we collect the results of the
+ # quality calculations
+
+ # Calculate quality for all the variants that are available.
+ for (@$variants) {
+ my($id, $qs, $ct, $enc, $cs, $lang, $bs) = @$_;
+ $qs = 1 unless defined $qs;
+ $ct = '' unless defined $ct;
+ $bs = 0 unless defined $bs;
+ $lang = lc($lang) if $lang; # lg tags are always case-insensitive
+ if ($DEBUG) {
+ print "\nEvaluating $id (ct='$ct')\n";
+ printf " qs = %.3f\n", $qs;
+ print " enc = $enc\n" if $enc && !ref($enc);
+ print " enc = @$enc\n" if $enc && ref($enc);
+ print " cs = $cs\n" if $cs;
+ print " lang = $lang\n" if $lang;
+ print " bs = $bs\n" if $bs;
+ }
+
+ # Calculate encoding quality
+ my $qe = 1;
+ # If the variant has no assigned Content-Encoding, or if no
+ # Accept-Encoding field is present, then the value assigned
+ # is "qe=1". If *all* of the variant's content encodings
+ # are listed in the Accept-Encoding field, then the value
+ # assigned is "qw=1". If *any* of the variant's content
+ # encodings are not listed in the provided Accept-Encoding
+ # field, then the value assigned is "qe=0"
+ if (exists $accept{'encoding'} && $enc) {
+ my @enc = ref($enc) ? @$enc : ($enc);
+ for (@enc) {
+ print "Is encoding $_ accepted? " if $DEBUG;
+ unless(exists $accept{'encoding'}{$_}) {
+ print "no\n" if $DEBUG;
+ $qe = 0;
+ last;
+ }
+ else {
+ print "yes\n" if $DEBUG;
+ }
+ }
+ }
+
+ # Calculate charset quality
+ my $qc = 1;
+ # If the variant's media-type has no charset parameter,
+ # or the variant's charset is US-ASCII, or if no Accept-Charset
+ # field is present, then the value assigned is "qc=1". If the
+ # variant's charset is listed in the Accept-Charset field,
+ # then the value assigned is "qc=1. Otherwise, if the variant's
+ # charset is not listed in the provided Accept-Encoding field,
+ # then the value assigned is "qc=0".
+ if (exists $accept{'charset'} && $cs && $cs ne 'us-ascii' ) {
+ $qc = 0 unless $accept{'charset'}{$cs};
+ }
+
+ # Calculate language quality
+ my $ql = 1;
+ if ($lang && exists $accept{'language'}) {
+ my @lang = ref($lang) ? @$lang : ($lang);
+ # If any of the variant's content languages are listed
+ # in the Accept-Language field, the the value assigned is
+ # the largest of the "q" parameter values for those language
+ # tags.
+ my $q = undef;
+ for (@lang) {
+ next unless exists $accept{'language'}{$_};
+ my $this_q = $accept{'language'}{$_}{'q'};
+ $q = $this_q unless defined $q;
+ $q = $this_q if $this_q > $q;
+ }
+ if(defined $q) {
+ $DEBUG and print " -- Exact language match at q=$q\n";
+ }
+ else {
+ # If there was no exact match and at least one of
+ # the Accept-Language field values is a complete
+ # subtag prefix of the content language tag(s), then
+ # the "q" parameter value of the largest matching
+ # prefix is used.
+ $DEBUG and print " -- No exact language match\n";
+ my $selected = undef;
+ for $al (keys %{ $accept{'language'} }) {
+ if (index($al, "$lang-") == 0) {
+ # $lang starting with $al isn't enough, or else
+ # Accept-Language: hu (Hungarian) would seem
+ # to accept a document in hup (Hupa)
+ $DEBUG and print " -- $al ISA $lang\n";
+ $selected = $al unless defined $selected;
+ $selected = $al if length($al) > length($selected);
+ }
+ else {
+ $DEBUG and print " -- $lang isn't a $al\n";
+ }
+ }
+ $q = $accept{'language'}{$selected}{'q'} if $selected;
+
+ # If none of the variant's content language tags or
+ # tag prefixes are listed in the provided
+ # Accept-Language field, then the value assigned
+ # is "ql=0.001"
+ $q = 0.001 unless defined $q;
+ }
+ $ql = $q;
+ }
+ else {
+ $ql = 0.5 if $any_lang && exists $accept{'language'};
+ }
+
+ my $q = 1;
+ my $mbx = undef;
+ # If no Accept field is given, then the value assigned is "q=1".
+ # If at least one listed media range matches the variant's media
+ # type, then the "q" parameter value assigned to the most specific
+ # of those matched is used (e.g. "text/html;version=3.0" is more
+ # specific than "text/html", which is more specific than "text/*",
+ # which in turn is more specific than "*/*"). If not media range
+ # in the provided Accept field matches the variant's media type,
+ # then the value assigned is "q=0".
+ if (exists $accept{'type'} && $ct) {
+ # First we clean up our content-type
+ $ct =~ s/\s+//g;
+ my $params = "";
+ $params = $1 if $ct =~ s/;(.*)//;
+ my($type, $subtype) = split("/", $ct, 2);
+ my %param = ();
+ for $param (split(/;/, $params)) {
+ my($pk,$pv) = split(/=/, $param, 2);
+ $param{$pk} = $pv;
+ }
+
+ my $sel_q = undef;
+ my $sel_mbx = undef;
+ my $sel_specificness = 0;
+
+ ACCEPT_TYPE:
+ for $at (keys %{ $accept{'type'} }) {
+ print "Consider $at...\n" if $DEBUG;
+ my($at_type, $at_subtype) = split("/", $at, 2);
+ # Is it a match on the type
+ next if $at_type ne '*' && $at_type ne $type;
+ next if $at_subtype ne '*' && $at_subtype ne $subtype;
+ my $specificness = 0;
+ $specificness++ if $at_type ne '*';
+ $specificness++ if $at_subtype ne '*';
+ # Let's see if content-type parameters also match
+ while (($pk, $pv) = each %param) {
+ print "Check if $pk = $pv is true\n" if $DEBUG;
+ next unless exists $accept{'type'}{$at}{$pk};
+ next ACCEPT_TYPE
+ unless $accept{'type'}{$at}{$pk} eq $pv;
+ print "yes it is!!\n" if $DEBUG;
+ $specificness++;
+ }
+ print "Hurray, type match with specificness = $specificness\n"
+ if $DEBUG;
+
+ if (!defined($sel_q) || $sel_specificness < $specificness) {
+ $sel_q = $accept{'type'}{$at}{'q'};
+ $sel_mbx = $accept{'type'}{$at}{'mbx'};
+ $sel_specificness = $specificness;
+ }
+ }
+ $q = $sel_q || 0;
+ $mbx = $sel_mbx;
+ }
+
+ my $Q;
+ if (!defined($mbx) || $mbx >= $bs) {
+ $Q = $qs * $qe * $qc * $ql * $q;
+ }
+ else {
+ $Q = 0;
+ print "Variant's size is too large ==> Q=0\n" if $DEBUG;
+ }
+
+ if ($DEBUG) {
+ $mbx = "undef" unless defined $mbx;
+ printf "Q=%.4f", $Q;
+ print " (q=$q, mbx=$mbx, qe=$qe, qc=$qc, ql=$ql, qs=$qs)\n";
+ }
+
+ push(@Q, [$id, $Q, $bs]);
+ }
+
+
+ @Q = sort { $b->[1] <=> $a->[1] || $a->[2] <=> $b->[2] } @Q;
+
+ return @Q if wantarray;
+ return undef unless @Q;
+ return undef if $Q[0][1] == 0;
+ $Q[0][0];
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+HTTP::Negotiate - choose a variant to serve
+
+=head1 SYNOPSIS
+
+ use HTTP::Negotiate qw(choose);
+
+ # ID QS Content-Type Encoding Char-Set Lang Size
+ $variants =
+ [['var1', 1.000, 'text/html', undef, 'iso-8859-1', 'en', 3000],
+ ['var2', 0.950, 'text/plain', 'gzip', 'us-ascii', 'no', 400],
+ ['var3', 0.3, 'image/gif', undef, undef, undef, 43555],
+ ];
+
+ @preferred = choose($variants, $request_headers);
+ $the_one = choose($variants);
+
+=head1 DESCRIPTION
+
+This module provides a complete implementation of the HTTP content
+negotiation algorithm specified in F<draft-ietf-http-v11-spec-00.ps>
+chapter 12. Content negotiation allows for the selection of a
+preferred content representation based upon attributes of the
+negotiable variants and the value of the various Accept* header fields
+in the request.
+
+The variants are ordered by preference by calling the function
+choose().
+
+The first parameter is reference to an array of the variants to
+choose among.
+Each element in this array is an array with the values [$id, $qs,
+$content_type, $content_encoding, $charset, $content_language,
+$content_length] whose meanings are described
+below. The $content_encoding and $content_language can be either a
+single scalar value or an array reference if there are several values.
+
+The second optional parameter is either a HTTP::Headers or a HTTP::Request
+object which is searched for "Accept*" headers. If this
+parameter is missing, then the accept specification is initialized
+from the CGI environment variables HTTP_ACCEPT, HTTP_ACCEPT_CHARSET,
+HTTP_ACCEPT_ENCODING and HTTP_ACCEPT_LANGUAGE.
+
+In an array context, choose() returns a list of [variant
+identifier, calculated quality, size] tuples. The values are sorted by
+quality, highest quality first. If the calculated quality is the same
+for two variants, then they are sorted by size (smallest first). I<E.g.>:
+
+ (['var1', 1, 2000], ['var2', 0.3, 512], ['var3', 0.3, 1024]);
+
+Note that also zero quality variants are included in the return list
+even if these should never be served to the client.
+
+In a scalar context, it returns the identifier of the variant with the
+highest score or C<undef> if none have non-zero quality.
+
+If the $HTTP::Negotiate::DEBUG variable is set to TRUE, then a lot of
+noise is generated on STDOUT during evaluation of choose().
+
+=head1 VARIANTS
+
+A variant is described by a list of the following values. If the
+attribute does not make sense or is unknown for a variant, then use
+C<undef> instead.
+
+=over 3
+
+=item identifier
+
+This is a string that you use as the name for the variant. This
+identifier for the preferred variants returned by choose().
+
+=item qs
+
+This is a number between 0.000 and 1.000 that describes the "source
+quality". This is what F<draft-ietf-http-v11-spec-00.ps> says about this
+value:
+
+Source quality is measured by the content provider as representing the
+amount of degradation from the original source. For example, a
+picture in JPEG form would have a lower qs when translated to the XBM
+format, and much lower qs when translated to an ASCII-art
+representation. Note, however, that this is a function of the source
+- an original piece of ASCII-art may degrade in quality if it is
+captured in JPEG form. The qs values should be assigned to each
+variant by the content provider; if no qs value has been assigned, the
+default is generally "qs=1".
+
+=item content-type
+
+This is the media type of the variant. The media type does not
+include a charset attribute, but might contain other parameters.
+Examples are:
+
+ text/html
+ text/html;version=2.0
+ text/plain
+ image/gif
+ image/jpg
+
+=item content-encoding
+
+This is one or more content encodings that has been applied to the
+variant. The content encoding is generally used as a modifier to the
+content media type. The most common content encodings are:
+
+ gzip
+ compress
+
+=item content-charset
+
+This is the character set used when the variant contains text.
+The charset value should generally be C<undef> or one of these:
+
+ us-ascii
+ iso-8859-1 ... iso-8859-9
+ iso-2022-jp
+ iso-2022-jp-2
+ iso-2022-kr
+ unicode-1-1
+ unicode-1-1-utf-7
+ unicode-1-1-utf-8
+
+=item content-language
+
+This describes one or more languages that are used in the variant.
+Language is described like this in F<draft-ietf-http-v11-spec-00.ps>: A
+language is in this context a natural language spoken, written, or
+otherwise conveyed by human beings for communication of information to
+other human beings. Computer languages are explicitly excluded.
+
+The language tags are defined by RFC 3066. Examples
+are:
+
+ no Norwegian
+ en International English
+ en-US US English
+ en-cockney
+
+=item content-length
+
+This is the number of bytes used to represent the content.
+
+=back
+
+=head1 ACCEPT HEADERS
+
+The following Accept* headers can be used for describing content
+preferences in a request (This description is an edited extract from
+F<draft-ietf-http-v11-spec-00.ps>):
+
+=over 3
+
+=item Accept
+
+This header can be used to indicate a list of media ranges which are
+acceptable as a response to the request. The "*" character is used to
+group media types into ranges, with "*/*" indicating all media types
+and "type/*" indicating all subtypes of that type.
+
+The parameter q is used to indicate the quality factor, which
+represents the user's preference for that range of media types. The
+parameter mbx gives the maximum acceptable size of the response
+content. The default values are: q=1 and mbx=infinity. If no Accept
+header is present, then the client accepts all media types with q=1.
+
+For example:
+
+ Accept: audio/*;q=0.2;mbx=200000, audio/basic
+
+would mean: "I prefer audio/basic (of any size), but send me any audio
+type if it is the best available after an 80% mark-down in quality and
+its size is less than 200000 bytes"
+
+
+=item Accept-Charset
+
+Used to indicate what character sets are acceptable for the response.
+The "us-ascii" character set is assumed to be acceptable for all user
+agents. If no Accept-Charset field is given, the default is that any
+charset is acceptable. Example:
+
+ Accept-Charset: iso-8859-1, unicode-1-1
+
+
+=item Accept-Encoding
+
+Restricts the Content-Encoding values which are acceptable in the
+response. If no Accept-Encoding field is present, the server may
+assume that the client will accept any content encoding. An empty
+Accept-Encoding means that no content encoding is acceptable. Example:
+
+ Accept-Encoding: compress, gzip
+
+
+=item Accept-Language
+
+This field is similar to Accept, but restricts the set of natural
+languages that are preferred in a response. Each language may be
+given an associated quality value which represents an estimate of the
+user's comprehension of that language. For example:
+
+ Accept-Language: no, en-gb;q=0.8, de;q=0.55
+
+would mean: "I prefer Norwegian, but will accept British English (with
+80% comprehension) or German (with 55% comprehension).
+
+=back
+
+
+=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.
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@aas.no>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Request.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Request.pm
new file mode 100644
index 0000000000..8998ceda3b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Request.pm
@@ -0,0 +1,344 @@
+package HTTP::Request;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+use base 'HTTP::Message';
+
+sub new
+{
+ my($class, $method, $uri, $header, $content) = @_;
+ my $self = $class->SUPER::new($header, $content);
+ $self->method($method);
+ $self->uri($uri);
+ $self;
+}
+
+
+sub parse
+{
+ my($class, $str) = @_;
+ Carp::carp('Undefined argument to parse()') if $^W && ! defined $str;
+ my $request_line;
+ if (defined $str && $str =~ s/^(.*)\n//) {
+ $request_line = $1;
+ }
+ else {
+ $request_line = $str;
+ $str = "";
+ }
+
+ my $self = $class->SUPER::parse($str);
+ if (defined $request_line) {
+ my($method, $uri, $protocol) = split(' ', $request_line);
+ $self->method($method);
+ $self->uri($uri) if defined($uri);
+ $self->protocol($protocol) if $protocol;
+ }
+ $self;
+}
+
+
+sub clone
+{
+ my $self = shift;
+ my $clone = bless $self->SUPER::clone, ref($self);
+ $clone->method($self->method);
+ $clone->uri($self->uri);
+ $clone;
+}
+
+
+sub method
+{
+ shift->_elem('_method', @_);
+}
+
+
+sub uri
+{
+ my $self = shift;
+ my $old = $self->{'_uri'};
+ if (@_) {
+ my $uri = shift;
+ if (!defined $uri) {
+ # that's ok
+ }
+ elsif (ref $uri) {
+ Carp::croak("A URI can't be a " . ref($uri) . " reference")
+ if ref($uri) eq 'HASH' or ref($uri) eq 'ARRAY';
+ Carp::croak("Can't use a " . ref($uri) . " object as a URI")
+ unless $uri->can('scheme') && $uri->can('canonical');
+ $uri = $uri->clone;
+ unless ($HTTP::URI_CLASS eq "URI") {
+ # Argh!! Hate this... old LWP legacy!
+ eval { local $SIG{__DIE__}; $uri = $uri->abs; };
+ die $@ if $@ && $@ !~ /Missing base argument/;
+ }
+ }
+ else {
+ $uri = $HTTP::URI_CLASS->new($uri);
+ }
+ $self->{'_uri'} = $uri;
+ delete $self->{'_uri_canonical'};
+ }
+ $old;
+}
+
+*url = \&uri; # legacy
+
+sub uri_canonical
+{
+ my $self = shift;
+ return $self->{'_uri_canonical'} ||= $self->{'_uri'}->canonical;
+}
+
+
+sub accept_decodable
+{
+ my $self = shift;
+ $self->header("Accept-Encoding", scalar($self->decodable));
+}
+
+sub as_string
+{
+ my $self = shift;
+ my($eol) = @_;
+ $eol = "\n" unless defined $eol;
+
+ my $req_line = $self->method || "-";
+ my $uri = $self->uri;
+ $uri = (defined $uri) ? $uri->as_string : "-";
+ $req_line .= " $uri";
+ my $proto = $self->protocol;
+ $req_line .= " $proto" if $proto;
+
+ return join($eol, $req_line, $self->SUPER::as_string(@_));
+}
+
+sub dump
+{
+ my $self = shift;
+ my @pre = ($self->method || "-", $self->uri || "-");
+ if (my $prot = $self->protocol) {
+ push(@pre, $prot);
+ }
+
+ return $self->SUPER::dump(
+ preheader => join(" ", @pre),
+ @_,
+ );
+}
+
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Request - HTTP style request message
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ require HTTP::Request;
+ $request = HTTP::Request->new(GET => 'http://www.example.com/');
+
+and usually used like this:
+
+ $ua = LWP::UserAgent->new;
+ $response = $ua->request($request);
+
+=head1 DESCRIPTION
+
+C<HTTP::Request> is a class encapsulating HTTP style requests,
+consisting of a request line, some headers, and a content body. Note
+that the LWP library uses HTTP style requests even for non-HTTP
+protocols. Instances of this class are usually passed to the
+request() method of an C<LWP::UserAgent> object.
+
+C<HTTP::Request> is a subclass of C<HTTP::Message> and therefore
+inherits its methods. The following additional methods are available:
+
+=over 4
+
+=item $r = HTTP::Request->new( $method, $uri )
+
+=item $r = HTTP::Request->new( $method, $uri, $header )
+
+=item $r = HTTP::Request->new( $method, $uri, $header, $content )
+
+Constructs a new C<HTTP::Request> object describing a request on the
+object $uri using method $method. The $method argument must be a
+string. The $uri argument can be either a string, or a reference to a
+C<URI> object. The optional $header argument should be a reference to
+an C<HTTP::Headers> object or a plain array reference of key/value
+pairs. The optional $content argument should be a string of bytes.
+
+=item $r = HTTP::Request->parse( $str )
+
+This constructs a new request object by parsing the given string.
+
+=item $r->method
+
+=item $r->method( $val )
+
+This is used to get/set the method attribute. The method should be a
+short string like "GET", "HEAD", "PUT", "PATCH" or "POST".
+
+=item $r->uri
+
+=item $r->uri( $val )
+
+This is used to get/set the uri attribute. The $val can be a
+reference to a URI object or a plain string. If a string is given,
+then it should be parsable as an absolute URI.
+
+=item $r->header( $field )
+
+=item $r->header( $field => $value )
+
+This is used to get/set header values and it is inherited from
+C<HTTP::Headers> via C<HTTP::Message>. See L<HTTP::Headers> for
+details and other similar methods that can be used to access the
+headers.
+
+=item $r->accept_decodable
+
+This will set the C<Accept-Encoding> header to the list of encodings
+that decoded_content() can decode.
+
+=item $r->content
+
+=item $r->content( $bytes )
+
+This is used to get/set the content and it is inherited from the
+C<HTTP::Message> base class. See L<HTTP::Message> for details and
+other methods that can be used to access the content.
+
+Note that the content should be a string of bytes. Strings in perl
+can contain characters outside the range of a byte. The C<Encode>
+module can be used to turn such strings into a string of bytes.
+
+=item $r->as_string
+
+=item $r->as_string( $eol )
+
+Method returning a textual representation of the request.
+
+=back
+
+=head1 EXAMPLES
+
+Creating requests to be sent with L<LWP::UserAgent> or others can be easy. Here
+are a few examples.
+
+=head2 Simple POST
+
+Here, we'll create a simple POST request that could be used to send JSON data
+to an endpoint.
+
+ #!/usr/bin/env perl
+
+ use strict;
+ use warnings;
+
+ use Encode qw(encode_utf8);
+ use HTTP::Request ();
+ use JSON::MaybeXS qw(encode_json);
+
+ my $url = 'https://www.example.com/api/user/123';
+ my $header = ['Content-Type' => 'application/json; charset=UTF-8'];
+ my $data = {foo => 'bar', baz => 'quux'};
+ my $encoded_data = encode_utf8(encode_json($data));
+
+ my $r = HTTP::Request->new('POST', $url, $header, $encoded_data);
+ # at this point, we could send it via LWP::UserAgent
+ # my $ua = LWP::UserAgent->new();
+ # my $res = $ua->request($r);
+
+=head2 Batch POST Request
+
+Some services, like Google, allow multiple requests to be sent in one batch.
+L<https://developers.google.com/drive/v3/web/batch> for example. Using the
+C<add_part> method from L<HTTP::Message> makes this simple.
+
+ #!/usr/bin/env perl
+
+ use strict;
+ use warnings;
+
+ use Encode qw(encode_utf8);
+ use HTTP::Request ();
+ use JSON::MaybeXS qw(encode_json);
+
+ my $auth_token = 'auth_token';
+ my $batch_url = 'https://www.googleapis.com/batch';
+ my $url = 'https://www.googleapis.com/drive/v3/files/fileId/permissions?fields=id';
+ my $url_no_email = 'https://www.googleapis.com/drive/v3/files/fileId/permissions?fields=id&sendNotificationEmail=false';
+
+ # generate a JSON post request for one of the batch entries
+ my $req1 = build_json_request($url, {
+ emailAddress => 'example@appsrocks.com',
+ role => "writer",
+ type => "user",
+ });
+
+ # generate a JSON post request for one of the batch entries
+ my $req2 = build_json_request($url_no_email, {
+ domain => "appsrocks.com",
+ role => "reader",
+ type => "domain",
+ });
+
+ # generate a multipart request to send all of the other requests
+ my $r = HTTP::Request->new('POST', $batch_url, [
+ 'Accept-Encoding' => 'gzip',
+ # if we don't provide a boundary here, HTTP::Message will generate
+ # one for us. We could use UUID::uuid() here if we wanted.
+ 'Content-Type' => 'multipart/mixed; boundary=END_OF_PART'
+ ]);
+
+ # add the two POST requests to the main request
+ $r->add_part($req1, $req2);
+ # at this point, we could send it via LWP::UserAgent
+ # my $ua = LWP::UserAgent->new();
+ # my $res = $ua->request($r);
+ exit();
+
+ sub build_json_request {
+ my ($url, $href) = @_;
+ my $header = ['Authorization' => "Bearer $auth_token", 'Content-Type' => 'application/json; charset=UTF-8'];
+ return HTTP::Request->new('POST', $url, $header, encode_utf8(encode_json($href)));
+ }
+
+=head1 SEE ALSO
+
+L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Request::Common>,
+L<HTTP::Response>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
+
+__END__
+
+
+#ABSTRACT: HTTP style request message
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Request/Common.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Request/Common.pm
new file mode 100644
index 0000000000..d70a939571
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Request/Common.pm
@@ -0,0 +1,560 @@
+package HTTP::Request::Common;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+our $DYNAMIC_FILE_UPLOAD ||= 0; # make it defined (don't know why)
+
+use Exporter 5.57 'import';
+
+our @EXPORT =qw(GET HEAD PUT PATCH POST);
+our @EXPORT_OK = qw($DYNAMIC_FILE_UPLOAD DELETE);
+
+require HTTP::Request;
+use Carp();
+
+my $CRLF = "\015\012"; # "\r\n" is not portable
+
+sub GET { _simple_req('GET', @_); }
+sub HEAD { _simple_req('HEAD', @_); }
+sub DELETE { _simple_req('DELETE', @_); }
+sub PATCH { request_type_with_data('PATCH', @_); }
+sub POST { request_type_with_data('POST', @_); }
+sub PUT { request_type_with_data('PUT', @_); }
+
+sub request_type_with_data
+{
+ my $type = shift;
+ my $url = shift;
+ my $req = HTTP::Request->new($type => $url);
+ my $content;
+ $content = shift if @_ and ref $_[0];
+ my($k, $v);
+ while (($k,$v) = splice(@_, 0, 2)) {
+ if (lc($k) eq 'content') {
+ $content = $v;
+ }
+ else {
+ $req->push_header($k, $v);
+ }
+ }
+ my $ct = $req->header('Content-Type');
+ unless ($ct) {
+ $ct = 'application/x-www-form-urlencoded';
+ }
+ elsif ($ct eq 'form-data') {
+ $ct = 'multipart/form-data';
+ }
+
+ if (ref $content) {
+ if ($ct =~ m,^multipart/form-data\s*(;|$),i) {
+ require HTTP::Headers::Util;
+ my @v = HTTP::Headers::Util::split_header_words($ct);
+ Carp::carp("Multiple Content-Type headers") if @v > 1;
+ @v = @{$v[0]};
+
+ my $boundary;
+ my $boundary_index;
+ for (my @tmp = @v; @tmp;) {
+ my($k, $v) = splice(@tmp, 0, 2);
+ if ($k eq "boundary") {
+ $boundary = $v;
+ $boundary_index = @v - @tmp - 1;
+ last;
+ }
+ }
+
+ ($content, $boundary) = form_data($content, $boundary, $req);
+
+ if ($boundary_index) {
+ $v[$boundary_index] = $boundary;
+ }
+ else {
+ push(@v, boundary => $boundary);
+ }
+
+ $ct = HTTP::Headers::Util::join_header_words(@v);
+ }
+ else {
+ # We use a temporary URI object to format
+ # the application/x-www-form-urlencoded content.
+ require URI;
+ my $url = URI->new('http:');
+ $url->query_form(ref($content) eq "HASH" ? %$content : @$content);
+ $content = $url->query;
+
+ # HTML/4.01 says that line breaks are represented as "CR LF" pairs (i.e., `%0D%0A')
+ $content =~ s/(?<!%0D)%0A/%0D%0A/g if defined($content);
+ }
+ }
+
+ $req->header('Content-Type' => $ct); # might be redundant
+ if (defined($content)) {
+ $req->header('Content-Length' =>
+ length($content)) unless ref($content);
+ $req->content($content);
+ }
+ else {
+ $req->header('Content-Length' => 0);
+ }
+ $req;
+}
+
+
+sub _simple_req
+{
+ my($method, $url) = splice(@_, 0, 2);
+ my $req = HTTP::Request->new($method => $url);
+ my($k, $v);
+ my $content;
+ while (($k,$v) = splice(@_, 0, 2)) {
+ if (lc($k) eq 'content') {
+ $req->add_content($v);
+ $content++;
+ }
+ else {
+ $req->push_header($k, $v);
+ }
+ }
+ if ($content && !defined($req->header("Content-Length"))) {
+ $req->header("Content-Length", length(${$req->content_ref}));
+ }
+ $req;
+}
+
+
+sub form_data # RFC1867
+{
+ my($data, $boundary, $req) = @_;
+ my @data = ref($data) eq "HASH" ? %$data : @$data; # copy
+ my $fhparts;
+ my @parts;
+ while (my ($k,$v) = splice(@data, 0, 2)) {
+ if (!ref($v)) {
+ $k =~ s/([\\\"])/\\$1/g; # escape quotes and backslashes
+ no warnings 'uninitialized';
+ push(@parts,
+ qq(Content-Disposition: form-data; name="$k"$CRLF$CRLF$v));
+ }
+ else {
+ my($file, $usename, @headers) = @$v;
+ unless (defined $usename) {
+ $usename = $file;
+ $usename =~ s,.*/,, if defined($usename);
+ }
+ $k =~ s/([\\\"])/\\$1/g;
+ my $disp = qq(form-data; name="$k");
+ if (defined($usename) and length($usename)) {
+ $usename =~ s/([\\\"])/\\$1/g;
+ $disp .= qq(; filename="$usename");
+ }
+ my $content = "";
+ my $h = HTTP::Headers->new(@headers);
+ if ($file) {
+ open(my $fh, "<", $file) or Carp::croak("Can't open file $file: $!");
+ binmode($fh);
+ if ($DYNAMIC_FILE_UPLOAD) {
+ # will read file later, close it now in order to
+ # not accumulate to many open file handles
+ close($fh);
+ $content = \$file;
+ }
+ else {
+ local($/) = undef; # slurp files
+ $content = <$fh>;
+ close($fh);
+ }
+ unless ($h->header("Content-Type")) {
+ require LWP::MediaTypes;
+ LWP::MediaTypes::guess_media_type($file, $h);
+ }
+ }
+ if ($h->header("Content-Disposition")) {
+ # just to get it sorted first
+ $disp = $h->header("Content-Disposition");
+ $h->remove_header("Content-Disposition");
+ }
+ if ($h->header("Content")) {
+ $content = $h->header("Content");
+ $h->remove_header("Content");
+ }
+ my $head = join($CRLF, "Content-Disposition: $disp",
+ $h->as_string($CRLF),
+ "");
+ if (ref $content) {
+ push(@parts, [$head, $$content]);
+ $fhparts++;
+ }
+ else {
+ push(@parts, $head . $content);
+ }
+ }
+ }
+ return ("", "none") unless @parts;
+
+ my $content;
+ if ($fhparts) {
+ $boundary = boundary(10) # hopefully enough randomness
+ unless $boundary;
+
+ # add the boundaries to the @parts array
+ for (1..@parts-1) {
+ splice(@parts, $_*2-1, 0, "$CRLF--$boundary$CRLF");
+ }
+ unshift(@parts, "--$boundary$CRLF");
+ push(@parts, "$CRLF--$boundary--$CRLF");
+
+ # See if we can generate Content-Length header
+ my $length = 0;
+ for (@parts) {
+ if (ref $_) {
+ my ($head, $f) = @$_;
+ my $file_size;
+ unless ( -f $f && ($file_size = -s _) ) {
+ # The file is either a dynamic file like /dev/audio
+ # or perhaps a file in the /proc file system where
+ # stat may return a 0 size even though reading it
+ # will produce data. So we cannot make
+ # a Content-Length header.
+ undef $length;
+ last;
+ }
+ $length += $file_size + length $head;
+ }
+ else {
+ $length += length;
+ }
+ }
+ $length && $req->header('Content-Length' => $length);
+
+ # set up a closure that will return content piecemeal
+ $content = sub {
+ for (;;) {
+ unless (@parts) {
+ defined $length && $length != 0 &&
+ Carp::croak "length of data sent did not match calculated Content-Length header. Probably because uploaded file changed in size during transfer.";
+ return;
+ }
+ my $p = shift @parts;
+ unless (ref $p) {
+ $p .= shift @parts while @parts && !ref($parts[0]);
+ defined $length && ($length -= length $p);
+ return $p;
+ }
+ my($buf, $fh) = @$p;
+ unless (ref($fh)) {
+ my $file = $fh;
+ undef($fh);
+ open($fh, "<", $file) || Carp::croak("Can't open file $file: $!");
+ binmode($fh);
+ }
+ my $buflength = length $buf;
+ my $n = read($fh, $buf, 2048, $buflength);
+ if ($n) {
+ $buflength += $n;
+ unshift(@parts, ["", $fh]);
+ }
+ else {
+ close($fh);
+ }
+ if ($buflength) {
+ defined $length && ($length -= $buflength);
+ return $buf
+ }
+ }
+ };
+
+ }
+ else {
+ $boundary = boundary() unless $boundary;
+
+ my $bno = 0;
+ CHECK_BOUNDARY:
+ {
+ for (@parts) {
+ if (index($_, $boundary) >= 0) {
+ # must have a better boundary
+ $boundary = boundary(++$bno);
+ redo CHECK_BOUNDARY;
+ }
+ }
+ last;
+ }
+ $content = "--$boundary$CRLF" .
+ join("$CRLF--$boundary$CRLF", @parts) .
+ "$CRLF--$boundary--$CRLF";
+ }
+
+ wantarray ? ($content, $boundary) : $content;
+}
+
+
+sub boundary
+{
+ my $size = shift || return "xYzZY";
+ require MIME::Base64;
+ my $b = MIME::Base64::encode(join("", map chr(rand(256)), 1..$size*3), "");
+ $b =~ s/[\W]/X/g; # ensure alnum only
+ $b;
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Request::Common - Construct common HTTP::Request objects
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ use HTTP::Request::Common;
+ $ua = LWP::UserAgent->new;
+ $ua->request(GET 'http://www.sn.no/');
+ $ua->request(POST 'http://somewhere/foo', [foo => bar, bar => foo]);
+ $ua->request(PATCH 'http://somewhere/foo', [foo => bar, bar => foo]);
+ $ua->request(PUT 'http://somewhere/foo', [foo => bar, bar => foo]);
+
+=head1 DESCRIPTION
+
+This module provides functions that return newly created C<HTTP::Request>
+objects. These functions are usually more convenient to use than the
+standard C<HTTP::Request> constructor for the most common requests.
+
+Note that L<LWP::UserAgent> has several convenience methods, including
+C<get>, C<head>, C<delete>, C<post> and C<put>.
+
+The following functions are provided:
+
+=over 4
+
+=item GET $url
+
+=item GET $url, Header => Value,...
+
+The C<GET> function returns an L<HTTP::Request> object initialized with
+the "GET" method and the specified URL. It is roughly equivalent to the
+following call
+
+ HTTP::Request->new(
+ GET => $url,
+ HTTP::Headers->new(Header => Value,...),
+ )
+
+but is less cluttered. What is different is that a header named
+C<Content> will initialize the content part of the request instead of
+setting a header field. Note that GET requests should normally not
+have a content, so this hack makes more sense for the C<PUT>, C<PATCH>
+ and C<POST> functions described below.
+
+The C<get(...)> method of L<LWP::UserAgent> exists as a shortcut for
+C<< $ua->request(GET ...) >>.
+
+=item HEAD $url
+
+=item HEAD $url, Header => Value,...
+
+Like GET() but the method in the request is "HEAD".
+
+The C<head(...)> method of L<LWP::UserAgent> exists as a shortcut for
+C<< $ua->request(HEAD ...) >>.
+
+=item DELETE $url
+
+=item DELETE $url, Header => Value,...
+
+Like C<GET> but the method in the request is C<DELETE>. This function
+is not exported by default.
+
+=item PATCH $url
+
+=item PATCH $url, Header => Value,...
+
+=item PATCH $url, $form_ref, Header => Value,...
+
+=item PATCH $url, Header => Value,..., Content => $form_ref
+
+=item PATCH $url, Header => Value,..., Content => $content
+
+The same as C<POST> below, but the method in the request is C<PATCH>.
+
+=item PUT $url
+
+=item PUT $url, Header => Value,...
+
+=item PUT $url, $form_ref, Header => Value,...
+
+=item PUT $url, Header => Value,..., Content => $form_ref
+
+=item PUT $url, Header => Value,..., Content => $content
+
+The same as C<POST> below, but the method in the request is C<PUT>
+
+=item POST $url
+
+=item POST $url, Header => Value,...
+
+=item POST $url, $form_ref, Header => Value,...
+
+=item POST $url, Header => Value,..., Content => $form_ref
+
+=item POST $url, Header => Value,..., Content => $content
+
+C<POST>, C<PATCH> and C<PUT> all work with the same parameters.
+
+ %data = ( title => 'something', body => something else' );
+ $ua = LWP::UserAgent->new();
+ $request = HTTP::Request::Common::POST( $url, [ %data ] );
+ $response = $ua->request($request);
+
+They take a second optional array or hash reference
+parameter C<$form_ref>. The content can also be specified
+directly using the C<Content> pseudo-header, and you may also provide
+the C<$form_ref> this way.
+
+The C<Content> pseudo-header steals a bit of the header field namespace as
+there is no way to directly specify a header that is actually called
+"Content". If you really need this you must update the request
+returned in a separate statement.
+
+The C<$form_ref> argument can be used to pass key/value pairs for the
+form content. By default we will initialize a request using the
+C<application/x-www-form-urlencoded> content type. This means that
+you can emulate an HTML E<lt>form> POSTing like this:
+
+ POST 'http://www.perl.org/survey.cgi',
+ [ name => 'Gisle Aas',
+ email => 'gisle@aas.no',
+ gender => 'M',
+ born => '1964',
+ perc => '3%',
+ ];
+
+This will create an L<HTTP::Request> object that looks like this:
+
+ POST http://www.perl.org/survey.cgi
+ Content-Length: 66
+ Content-Type: application/x-www-form-urlencoded
+
+ name=Gisle%20Aas&email=gisle%40aas.no&gender=M&born=1964&perc=3%25
+
+Multivalued form fields can be specified by either repeating the field
+name or by passing the value as an array reference.
+
+The POST method also supports the C<multipart/form-data> content used
+for I<Form-based File Upload> as specified in RFC 1867. You trigger
+this content format by specifying a content type of C<'form-data'> as
+one of the request headers. If one of the values in the C<$form_ref> is
+an array reference, then it is treated as a file part specification
+with the following interpretation:
+
+ [ $file, $filename, Header => Value... ]
+ [ undef, $filename, Header => Value,..., Content => $content ]
+
+The first value in the array ($file) is the name of a file to open.
+This file will be read and its content placed in the request. The
+routine will croak if the file can't be opened. Use an C<undef> as
+$file value if you want to specify the content directly with a
+C<Content> header. The $filename is the filename to report in the
+request. If this value is undefined, then the basename of the $file
+will be used. You can specify an empty string as $filename if you
+want to suppress sending the filename when you provide a $file value.
+
+If a $file is provided by no C<Content-Type> header, then C<Content-Type>
+and C<Content-Encoding> will be filled in automatically with the values
+returned by C<LWP::MediaTypes::guess_media_type()>
+
+Sending my F<~/.profile> to the survey used as example above can be
+achieved by this:
+
+ POST 'http://www.perl.org/survey.cgi',
+ Content_Type => 'form-data',
+ Content => [ name => 'Gisle Aas',
+ email => 'gisle@aas.no',
+ gender => 'M',
+ born => '1964',
+ init => ["$ENV{HOME}/.profile"],
+ ]
+
+This will create an L<HTTP::Request> object that almost looks this (the
+boundary and the content of your F<~/.profile> is likely to be
+different):
+
+ POST http://www.perl.org/survey.cgi
+ Content-Length: 388
+ Content-Type: multipart/form-data; boundary="6G+f"
+
+ --6G+f
+ Content-Disposition: form-data; name="name"
+
+ Gisle Aas
+ --6G+f
+ Content-Disposition: form-data; name="email"
+
+ gisle@aas.no
+ --6G+f
+ Content-Disposition: form-data; name="gender"
+
+ M
+ --6G+f
+ Content-Disposition: form-data; name="born"
+
+ 1964
+ --6G+f
+ Content-Disposition: form-data; name="init"; filename=".profile"
+ Content-Type: text/plain
+
+ PATH=/local/perl/bin:$PATH
+ export PATH
+
+ --6G+f--
+
+If you set the C<$DYNAMIC_FILE_UPLOAD> variable (exportable) to some TRUE
+value, then you get back a request object with a subroutine closure as
+the content attribute. This subroutine will read the content of any
+files on demand and return it in suitable chunks. This allow you to
+upload arbitrary big files without using lots of memory. You can even
+upload infinite files like F</dev/audio> if you wish; however, if
+the file is not a plain file, there will be no C<Content-Length> header
+defined for the request. Not all servers (or server
+applications) like this. Also, if the file(s) change in size between
+the time the C<Content-Length> is calculated and the time that the last
+chunk is delivered, the subroutine will C<Croak>.
+
+The C<post(...)> method of L<LWP::UserAgent> exists as a shortcut for
+C<< $ua->request(POST ...) >>.
+
+=back
+
+=head1 SEE ALSO
+
+L<HTTP::Request>, L<LWP::UserAgent>
+
+Also, there are some examples in L<HTTP::Request/"EXAMPLES"> that you might
+find useful. For example, batch requests are explained there.
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
+
+__END__
+
+
+#ABSTRACT: Construct common HTTP::Request objects
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Response.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Response.pm
new file mode 100644
index 0000000000..31d7a387fe
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Response.pm
@@ -0,0 +1,665 @@
+package HTTP::Response;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+use base 'HTTP::Message';
+
+use HTTP::Status ();
+
+
+sub new
+{
+ my($class, $rc, $msg, $header, $content) = @_;
+ my $self = $class->SUPER::new($header, $content);
+ $self->code($rc);
+ $self->message($msg);
+ $self;
+}
+
+
+sub parse
+{
+ my($class, $str) = @_;
+ Carp::carp('Undefined argument to parse()') if $^W && ! defined $str;
+ my $status_line;
+ if (defined $str && $str =~ s/^(.*)\n//) {
+ $status_line = $1;
+ }
+ else {
+ $status_line = $str;
+ $str = "";
+ }
+
+ $status_line =~ s/\r\z// if defined $status_line;
+
+ my $self = $class->SUPER::parse($str);
+ if (defined $status_line) {
+ my($protocol, $code, $message);
+ if ($status_line =~ /^\d{3} /) {
+ # Looks like a response created by HTTP::Response->new
+ ($code, $message) = split(' ', $status_line, 2);
+ } else {
+ ($protocol, $code, $message) = split(' ', $status_line, 3);
+ }
+ $self->protocol($protocol) if $protocol;
+ $self->code($code) if defined($code);
+ $self->message($message) if defined($message);
+ }
+ $self;
+}
+
+
+sub clone
+{
+ my $self = shift;
+ my $clone = bless $self->SUPER::clone, ref($self);
+ $clone->code($self->code);
+ $clone->message($self->message);
+ $clone->request($self->request->clone) if $self->request;
+ # we don't clone previous
+ $clone;
+}
+
+
+sub code { shift->_elem('_rc', @_); }
+sub message { shift->_elem('_msg', @_); }
+sub previous { shift->_elem('_previous',@_); }
+sub request { shift->_elem('_request', @_); }
+
+
+sub status_line
+{
+ my $self = shift;
+ my $code = $self->{'_rc'} || "000";
+ my $mess = $self->{'_msg'} || HTTP::Status::status_message($code) || "Unknown code";
+ return "$code $mess";
+}
+
+
+sub base
+{
+ my $self = shift;
+ my $base = (
+ $self->header('Content-Base'), # used to be HTTP/1.1
+ $self->header('Content-Location'), # HTTP/1.1
+ $self->header('Base'), # HTTP/1.0
+ )[0];
+ if ($base && $base =~ /^$URI::scheme_re:/o) {
+ # already absolute
+ return $HTTP::URI_CLASS->new($base);
+ }
+
+ my $req = $self->request;
+ if ($req) {
+ # if $base is undef here, the return value is effectively
+ # just a copy of $self->request->uri.
+ return $HTTP::URI_CLASS->new_abs($base, $req->uri);
+ }
+
+ # can't find an absolute base
+ return undef;
+}
+
+
+sub redirects {
+ my $self = shift;
+ my @r;
+ my $r = $self;
+ while (my $p = $r->previous) {
+ push(@r, $p);
+ $r = $p;
+ }
+ return @r unless wantarray;
+ return reverse @r;
+}
+
+
+sub filename
+{
+ my $self = shift;
+ my $file;
+
+ my $cd = $self->header('Content-Disposition');
+ if ($cd) {
+ require HTTP::Headers::Util;
+ if (my @cd = HTTP::Headers::Util::split_header_words($cd)) {
+ my ($disposition, undef, %cd_param) = @{$cd[-1]};
+ $file = $cd_param{filename};
+
+ # RFC 2047 encoded?
+ if ($file && $file =~ /^=\?(.+?)\?(.+?)\?(.+)\?=$/) {
+ my $charset = $1;
+ my $encoding = uc($2);
+ my $encfile = $3;
+
+ if ($encoding eq 'Q' || $encoding eq 'B') {
+ local($SIG{__DIE__});
+ eval {
+ if ($encoding eq 'Q') {
+ $encfile =~ s/_/ /g;
+ require MIME::QuotedPrint;
+ $encfile = MIME::QuotedPrint::decode($encfile);
+ }
+ else { # $encoding eq 'B'
+ require MIME::Base64;
+ $encfile = MIME::Base64::decode($encfile);
+ }
+
+ require Encode;
+ require Encode::Locale;
+ Encode::from_to($encfile, $charset, "locale_fs");
+ };
+
+ $file = $encfile unless $@;
+ }
+ }
+ }
+ }
+
+ unless (defined($file) && length($file)) {
+ my $uri;
+ if (my $cl = $self->header('Content-Location')) {
+ $uri = URI->new($cl);
+ }
+ elsif (my $request = $self->request) {
+ $uri = $request->uri;
+ }
+
+ if ($uri) {
+ $file = ($uri->path_segments)[-1];
+ }
+ }
+
+ if ($file) {
+ $file =~ s,.*[\\/],,; # basename
+ }
+
+ if ($file && !length($file)) {
+ $file = undef;
+ }
+
+ $file;
+}
+
+
+sub as_string
+{
+ my $self = shift;
+ my($eol) = @_;
+ $eol = "\n" unless defined $eol;
+
+ my $status_line = $self->status_line;
+ my $proto = $self->protocol;
+ $status_line = "$proto $status_line" if $proto;
+
+ return join($eol, $status_line, $self->SUPER::as_string(@_));
+}
+
+
+sub dump
+{
+ my $self = shift;
+
+ my $status_line = $self->status_line;
+ my $proto = $self->protocol;
+ $status_line = "$proto $status_line" if $proto;
+
+ return $self->SUPER::dump(
+ preheader => $status_line,
+ @_,
+ );
+}
+
+
+sub is_info { HTTP::Status::is_info (shift->{'_rc'}); }
+sub is_success { HTTP::Status::is_success (shift->{'_rc'}); }
+sub is_redirect { HTTP::Status::is_redirect (shift->{'_rc'}); }
+sub is_error { HTTP::Status::is_error (shift->{'_rc'}); }
+sub is_client_error { HTTP::Status::is_client_error (shift->{'_rc'}); }
+sub is_server_error { HTTP::Status::is_server_error (shift->{'_rc'}); }
+
+
+sub error_as_HTML
+{
+ my $self = shift;
+ my $title = 'An Error Occurred';
+ my $body = $self->status_line;
+ $body =~ s/&/&amp;/g;
+ $body =~ s/</&lt;/g;
+ return <<EOM;
+<html>
+<head><title>$title</title></head>
+<body>
+<h1>$title</h1>
+<p>$body</p>
+</body>
+</html>
+EOM
+}
+
+
+sub current_age
+{
+ my $self = shift;
+ my $time = shift;
+
+ # Implementation of RFC 2616 section 13.2.3
+ # (age calculations)
+ my $response_time = $self->client_date;
+ my $date = $self->date;
+
+ my $age = 0;
+ if ($response_time && $date) {
+ $age = $response_time - $date; # apparent_age
+ $age = 0 if $age < 0;
+ }
+
+ my $age_v = $self->header('Age');
+ if ($age_v && $age_v > $age) {
+ $age = $age_v; # corrected_received_age
+ }
+
+ if ($response_time) {
+ my $request = $self->request;
+ if ($request) {
+ my $request_time = $request->date;
+ if ($request_time && $request_time < $response_time) {
+ # Add response_delay to age to get 'corrected_initial_age'
+ $age += $response_time - $request_time;
+ }
+ }
+ $age += ($time || time) - $response_time;
+ }
+ return $age;
+}
+
+
+sub freshness_lifetime
+{
+ my($self, %opt) = @_;
+
+ # First look for the Cache-Control: max-age=n header
+ for my $cc ($self->header('Cache-Control')) {
+ for my $cc_dir (split(/\s*,\s*/, $cc)) {
+ return $1 if $cc_dir =~ /^max-age\s*=\s*(\d+)/i;
+ }
+ }
+
+ # Next possibility is to look at the "Expires" header
+ my $date = $self->date || $self->client_date || $opt{time} || time;
+ if (my $expires = $self->expires) {
+ return $expires - $date;
+ }
+
+ # Must apply heuristic expiration
+ return undef if exists $opt{heuristic_expiry} && !$opt{heuristic_expiry};
+
+ # Default heuristic expiration parameters
+ $opt{h_min} ||= 60;
+ $opt{h_max} ||= 24 * 3600;
+ $opt{h_lastmod_fraction} ||= 0.10; # 10% since last-mod suggested by RFC2616
+ $opt{h_default} ||= 3600;
+
+ # Should give a warning if more than 24 hours according to
+ # RFC 2616 section 13.2.4. Here we just make this the default
+ # maximum value.
+
+ if (my $last_modified = $self->last_modified) {
+ my $h_exp = ($date - $last_modified) * $opt{h_lastmod_fraction};
+ return $opt{h_min} if $h_exp < $opt{h_min};
+ return $opt{h_max} if $h_exp > $opt{h_max};
+ return $h_exp;
+ }
+
+ # default when all else fails
+ return $opt{h_min} if $opt{h_min} > $opt{h_default};
+ return $opt{h_default};
+}
+
+
+sub is_fresh
+{
+ my($self, %opt) = @_;
+ $opt{time} ||= time;
+ my $f = $self->freshness_lifetime(%opt);
+ return undef unless defined($f);
+ return $f > $self->current_age($opt{time});
+}
+
+
+sub fresh_until
+{
+ my($self, %opt) = @_;
+ $opt{time} ||= time;
+ my $f = $self->freshness_lifetime(%opt);
+ return undef unless defined($f);
+ return $f - $self->current_age($opt{time}) + $opt{time};
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Response - HTTP style response message
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+Response objects are returned by the request() method of the C<LWP::UserAgent>:
+
+ # ...
+ $response = $ua->request($request);
+ if ($response->is_success) {
+ print $response->decoded_content;
+ }
+ else {
+ print STDERR $response->status_line, "\n";
+ }
+
+=head1 DESCRIPTION
+
+The C<HTTP::Response> class encapsulates HTTP style responses. A
+response consists of a response line, some headers, and a content
+body. Note that the LWP library uses HTTP style responses even for
+non-HTTP protocol schemes. Instances of this class are usually
+created and returned by the request() method of an C<LWP::UserAgent>
+object.
+
+C<HTTP::Response> is a subclass of C<HTTP::Message> and therefore
+inherits its methods. The following additional methods are available:
+
+=over 4
+
+=item $r = HTTP::Response->new( $code )
+
+=item $r = HTTP::Response->new( $code, $msg )
+
+=item $r = HTTP::Response->new( $code, $msg, $header )
+
+=item $r = HTTP::Response->new( $code, $msg, $header, $content )
+
+Constructs a new C<HTTP::Response> object describing a response with
+response code $code and optional message $msg. The optional $header
+argument should be a reference to an C<HTTP::Headers> object or a
+plain array reference of key/value pairs. The optional $content
+argument should be a string of bytes. The meanings of these arguments are
+described below.
+
+=item $r = HTTP::Response->parse( $str )
+
+This constructs a new response object by parsing the given string.
+
+=item $r->code
+
+=item $r->code( $code )
+
+This is used to get/set the code attribute. The code is a 3 digit
+number that encode the overall outcome of an HTTP response. The
+C<HTTP::Status> module provide constants that provide mnemonic names
+for the code attribute.
+
+=item $r->message
+
+=item $r->message( $message )
+
+This is used to get/set the message attribute. The message is a short
+human readable single line string that explains the response code.
+
+=item $r->header( $field )
+
+=item $r->header( $field => $value )
+
+This is used to get/set header values and it is inherited from
+C<HTTP::Headers> via C<HTTP::Message>. See L<HTTP::Headers> for
+details and other similar methods that can be used to access the
+headers.
+
+=item $r->content
+
+=item $r->content( $bytes )
+
+This is used to get/set the raw content and it is inherited from the
+C<HTTP::Message> base class. See L<HTTP::Message> for details and
+other methods that can be used to access the content.
+
+=item $r->decoded_content( %options )
+
+This will return the content after any C<Content-Encoding> and
+charsets have been decoded. See L<HTTP::Message> for details.
+
+=item $r->request
+
+=item $r->request( $request )
+
+This is used to get/set the request attribute. The request attribute
+is a reference to the request that caused this response. It does
+not have to be the same request passed to the $ua->request() method,
+because there might have been redirects and authorization retries in
+between.
+
+=item $r->previous
+
+=item $r->previous( $response )
+
+This is used to get/set the previous attribute. The previous
+attribute is used to link together chains of responses. You get
+chains of responses if the first response is redirect or unauthorized.
+The value is C<undef> if this is the first response in a chain.
+
+Note that the method $r->redirects is provided as a more convenient
+way to access the response chain.
+
+=item $r->status_line
+
+Returns the string "E<lt>code> E<lt>message>". If the message attribute
+is not set then the official name of E<lt>code> (see L<HTTP::Status>)
+is substituted.
+
+=item $r->base
+
+Returns the base URI for this response. The return value will be a
+reference to a URI object.
+
+The base URI is obtained from one the following sources (in priority
+order):
+
+=over 4
+
+=item 1.
+
+Embedded in the document content, for instance <BASE HREF="...">
+in HTML documents.
+
+=item 2.
+
+A "Content-Base:" or a "Content-Location:" header in the response.
+
+For backwards compatibility with older HTTP implementations we will
+also look for the "Base:" header.
+
+=item 3.
+
+The URI used to request this response. This might not be the original
+URI that was passed to $ua->request() method, because we might have
+received some redirect responses first.
+
+=back
+
+If none of these sources provide an absolute URI, undef is returned.
+
+When the LWP protocol modules produce the HTTP::Response object, then any base
+URI embedded in the document (step 1) will already have initialized the
+"Content-Base:" header. (See L<LWP::UserAgent/parse_head>). This means that
+this method only performs the last 2 steps (the content is not always available
+either).
+
+=item $r->filename
+
+Returns a filename for this response. Note that doing sanity checks
+on the returned filename (eg. removing characters that cannot be used
+on the target filesystem where the filename would be used, and
+laundering it for security purposes) are the caller's responsibility;
+the only related thing done by this method is that it makes a simple
+attempt to return a plain filename with no preceding path segments.
+
+The filename is obtained from one the following sources (in priority
+order):
+
+=over 4
+
+=item 1.
+
+A "Content-Disposition:" header in the response. Proper decoding of
+RFC 2047 encoded filenames requires the C<MIME::QuotedPrint> (for "Q"
+encoding), C<MIME::Base64> (for "B" encoding), and C<Encode> modules.
+
+=item 2.
+
+A "Content-Location:" header in the response.
+
+=item 3.
+
+The URI used to request this response. This might not be the original
+URI that was passed to $ua->request() method, because we might have
+received some redirect responses first.
+
+=back
+
+If a filename cannot be derived from any of these sources, undef is
+returned.
+
+=item $r->as_string
+
+=item $r->as_string( $eol )
+
+Returns a textual representation of the response.
+
+=item $r->is_info
+
+=item $r->is_success
+
+=item $r->is_redirect
+
+=item $r->is_error
+
+=item $r->is_client_error
+
+=item $r->is_server_error
+
+These methods indicate if the response was informational, successful, a
+redirection, or an error. See L<HTTP::Status> for the meaning of these.
+
+=item $r->error_as_HTML
+
+Returns a string containing a complete HTML document indicating what
+error occurred. This method should only be called when $r->is_error
+is TRUE.
+
+=item $r->redirects
+
+Returns the list of redirect responses that lead up to this response
+by following the $r->previous chain. The list order is oldest first.
+
+In scalar context return the number of redirect responses leading up
+to this one.
+
+=item $r->current_age
+
+Calculates the "current age" of the response as specified by RFC 2616
+section 13.2.3. The age of a response is the time since it was sent
+by the origin server. The returned value is a number representing the
+age in seconds.
+
+=item $r->freshness_lifetime( %opt )
+
+Calculates the "freshness lifetime" of the response as specified by
+RFC 2616 section 13.2.4. The "freshness lifetime" is the length of
+time between the generation of a response and its expiration time.
+The returned value is the number of seconds until expiry.
+
+If the response does not contain an "Expires" or a "Cache-Control"
+header, then this function will apply some simple heuristic based on
+the "Last-Modified" header to determine a suitable lifetime. The
+following options might be passed to control the heuristics:
+
+=over
+
+=item heuristic_expiry => $bool
+
+If passed as a FALSE value, don't apply heuristics and just return
+C<undef> when "Expires" or "Cache-Control" is lacking.
+
+=item h_lastmod_fraction => $num
+
+This number represent the fraction of the difference since the
+"Last-Modified" timestamp to make the expiry time. The default is
+C<0.10>, the suggested typical setting of 10% in RFC 2616.
+
+=item h_min => $sec
+
+This is the lower limit of the heuristic expiry age to use. The
+default is C<60> (1 minute).
+
+=item h_max => $sec
+
+This is the upper limit of the heuristic expiry age to use. The
+default is C<86400> (24 hours).
+
+=item h_default => $sec
+
+This is the expiry age to use when nothing else applies. The default
+is C<3600> (1 hour) or "h_min" if greater.
+
+=back
+
+=item $r->is_fresh( %opt )
+
+Returns TRUE if the response is fresh, based on the values of
+freshness_lifetime() and current_age(). If the response is no longer
+fresh, then it has to be re-fetched or re-validated by the origin
+server.
+
+Options might be passed to control expiry heuristics, see the
+description of freshness_lifetime().
+
+=item $r->fresh_until( %opt )
+
+Returns the time (seconds since epoch) when this entity is no longer fresh.
+
+Options might be passed to control expiry heuristics, see the
+description of freshness_lifetime().
+
+=back
+
+=head1 SEE ALSO
+
+L<HTTP::Headers>, L<HTTP::Message>, L<HTTP::Status>, L<HTTP::Request>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
+
+__END__
+
+
+#ABSTRACT: HTTP style response message
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Status.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Status.pm
new file mode 100644
index 0000000000..8cf997464f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/HTTP/Status.pm
@@ -0,0 +1,348 @@
+package HTTP::Status;
+
+use strict;
+use warnings;
+
+our $VERSION = '6.18';
+
+require 5.002; # because we use prototypes
+
+use base 'Exporter';
+our @EXPORT = qw(is_info is_success is_redirect is_error status_message);
+our @EXPORT_OK = qw(is_client_error is_server_error is_cacheable_by_default);
+
+# Note also addition of mnemonics to @EXPORT below
+
+# Unmarked codes are from RFC 7231 (2017-12-20)
+# See also:
+# https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml
+
+my %StatusCode = (
+ 100 => 'Continue',
+ 101 => 'Switching Protocols',
+ 102 => 'Processing', # RFC 2518: WebDAV
+ 103 => 'Early Hints', # RFC 8297: Indicating Hints
+# 104 .. 199
+ 200 => 'OK',
+ 201 => 'Created',
+ 202 => 'Accepted',
+ 203 => 'Non-Authoritative Information',
+ 204 => 'No Content',
+ 205 => 'Reset Content',
+ 206 => 'Partial Content', # RFC 7233: Range Requests
+ 207 => 'Multi-Status', # RFC 4918: WebDAV
+ 208 => 'Already Reported', # RFC 5842: WebDAV bindings
+# 209 .. 225
+ 226 => 'IM used', # RFC 3229: Delta encoding
+# 227 .. 299
+ 300 => 'Multiple Choices',
+ 301 => 'Moved Permanently',
+ 302 => 'Found',
+ 303 => 'See Other',
+ 304 => 'Not Modified', # RFC 7232: Conditional Request
+ 305 => 'Use Proxy',
+ 307 => 'Temporary Redirect',
+ 308 => 'Permanent Redirect', # RFC 7528: Permanent Redirect
+# 309 .. 399
+ 400 => 'Bad Request',
+ 401 => 'Unauthorized', # RFC 7235: Authentication
+ 402 => 'Payment Required',
+ 403 => 'Forbidden',
+ 404 => 'Not Found',
+ 405 => 'Method Not Allowed',
+ 406 => 'Not Acceptable',
+ 407 => 'Proxy Authentication Required', # RFC 7235: Authentication
+ 408 => 'Request Timeout',
+ 409 => 'Conflict',
+ 410 => 'Gone',
+ 411 => 'Length Required',
+ 412 => 'Precondition Failed', # RFC 7232: Conditional Request
+ 413 => 'Request Entity Too Large',
+ 414 => 'Request-URI Too Large',
+ 415 => 'Unsupported Media Type',
+ 416 => 'Request Range Not Satisfiable', # RFC 7233: Range Requests
+ 417 => 'Expectation Failed',
+# 418 .. 420
+ 421 => 'Misdirected Request', # RFC 7540: HTTP/2
+ 422 => 'Unprocessable Entity', # RFC 4918: WebDAV
+ 423 => 'Locked', # RFC 4918: WebDAV
+ 424 => 'Failed Dependency', # RFC 4918: WebDAV
+# 425
+ 426 => 'Upgrade Required',
+# 427
+ 428 => 'Precondition Required', # RFC 6585: Additional Codes
+ 429 => 'Too Many Requests', # RFC 6585: Additional Codes
+# 430
+ 431 => 'Request Header Fields Too Large', # RFC 6585: Additional Codes
+# 432 .. 450
+ 451 => 'Unavailable For Legal Reasons', # RFC 7724: Legal Obstacles
+# 452 .. 499
+ 500 => 'Internal Server Error',
+ 501 => 'Not Implemented',
+ 502 => 'Bad Gateway',
+ 503 => 'Service Unavailable',
+ 504 => 'Gateway Timeout',
+ 505 => 'HTTP Version Not Supported',
+ 506 => 'Variant Also Negotiates', # RFC 2295: Transparant Ngttn
+ 507 => 'Insufficient Storage', # RFC 4918: WebDAV
+ 508 => 'Loop Detected', # RFC 5842: WebDAV bindings
+# 509
+ 510 => 'Not Extended', # RFC 2774: Extension Framework
+ 511 => 'Network Authentication Required', # RFC 6585: Additional Codes
+);
+
+# keep some unofficial codes that used to be in this distribution
+%StatusCode = (
+ %StatusCode,
+ 418 => 'I\'m a teapot', # RFC 2324: HTCPC/1.0 1-april
+ 425 => 'Unordered Collection', # WebDAV Draft
+ 449 => 'Retry with', # microsoft
+ 509 => 'Bandwidth Limit Exceeded', # Apache / cPanel
+);
+
+my $mnemonicCode = '';
+my ($code, $message);
+while (($code, $message) = each %StatusCode) {
+ # create mnemonic subroutines
+ $message =~ s/I'm/I am/;
+ $message =~ tr/a-z \-/A-Z__/;
+ $mnemonicCode .= "sub HTTP_$message () { $code }\n";
+ $mnemonicCode .= "*RC_$message = \\&HTTP_$message;\n"; # legacy
+ $mnemonicCode .= "push(\@EXPORT_OK, 'HTTP_$message');\n";
+ $mnemonicCode .= "push(\@EXPORT, 'RC_$message');\n";
+}
+eval $mnemonicCode; # only one eval for speed
+die if $@;
+
+# backwards compatibility
+*RC_MOVED_TEMPORARILY = \&RC_FOUND; # 302 was renamed in the standard
+push(@EXPORT, "RC_MOVED_TEMPORARILY");
+
+*RC_NO_CODE = \&RC_UNORDERED_COLLECTION;
+push(@EXPORT, "RC_NO_CODE");
+
+our %EXPORT_TAGS = (
+ constants => [grep /^HTTP_/, @EXPORT_OK],
+ is => [grep /^is_/, @EXPORT, @EXPORT_OK],
+);
+
+
+sub status_message ($) { $StatusCode{$_[0]}; }
+
+sub is_info ($) { $_[0] && $_[0] >= 100 && $_[0] < 200; }
+sub is_success ($) { $_[0] && $_[0] >= 200 && $_[0] < 300; }
+sub is_redirect ($) { $_[0] && $_[0] >= 300 && $_[0] < 400; }
+sub is_error ($) { $_[0] && $_[0] >= 400 && $_[0] < 600; }
+sub is_client_error ($) { $_[0] && $_[0] >= 400 && $_[0] < 500; }
+sub is_server_error ($) { $_[0] && $_[0] >= 500 && $_[0] < 600; }
+sub is_cacheable_by_default ($) { $_[0] && ( $_[0] == 200 # OK
+ || $_[0] == 203 # Non-Authoritative Information
+ || $_[0] == 204 # No Content
+ || $_[0] == 206 # Not Acceptable
+ || $_[0] == 300 # Multiple Choices
+ || $_[0] == 301 # Moved Permanently
+ || $_[0] == 404 # Not Found
+ || $_[0] == 405 # Method Not Allowed
+ || $_[0] == 410 # Gone
+ || $_[0] == 414 # Request-URI Too Large
+ || $_[0] == 451 # Unavailable For Legal Reasons
+ || $_[0] == 501 # Not Implemented
+ );
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+HTTP::Status - HTTP Status code processing
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ use HTTP::Status qw(:constants :is status_message);
+
+ if ($rc != HTTP_OK) {
+ print status_message($rc), "\n";
+ }
+
+ if (is_success($rc)) { ... }
+ if (is_error($rc)) { ... }
+ if (is_redirect($rc)) { ... }
+
+=head1 DESCRIPTION
+
+I<HTTP::Status> is a library of routines for defining and
+classifying HTTP status codes for libwww-perl. Status codes are
+used to encode the overall outcome of an HTTP response message. Codes
+correspond to those defined in RFC 2616 and RFC 2518.
+
+=head1 CONSTANTS
+
+The following constant functions can be used as mnemonic status code
+names. None of these are exported by default. Use the C<:constants>
+tag to import them all.
+
+ HTTP_CONTINUE (100)
+ HTTP_SWITCHING_PROTOCOLS (101)
+ HTTP_PROCESSING (102)
+ HTTP_EARLY_HINTS (103)
+
+ HTTP_OK (200)
+ HTTP_CREATED (201)
+ HTTP_ACCEPTED (202)
+ HTTP_NON_AUTHORITATIVE_INFORMATION (203)
+ HTTP_NO_CONTENT (204)
+ HTTP_RESET_CONTENT (205)
+ HTTP_PARTIAL_CONTENT (206)
+ HTTP_MULTI_STATUS (207)
+ HTTP_ALREADY_REPORTED (208)
+
+ HTTP_IM_USED (226)
+
+ HTTP_MULTIPLE_CHOICES (300)
+ HTTP_MOVED_PERMANENTLY (301)
+ HTTP_FOUND (302)
+ HTTP_SEE_OTHER (303)
+ HTTP_NOT_MODIFIED (304)
+ HTTP_USE_PROXY (305)
+ HTTP_TEMPORARY_REDIRECT (307)
+ HTTP_PERMANENT_REDIRECT (308)
+
+ HTTP_BAD_REQUEST (400)
+ HTTP_UNAUTHORIZED (401)
+ HTTP_PAYMENT_REQUIRED (402)
+ HTTP_FORBIDDEN (403)
+ HTTP_NOT_FOUND (404)
+ HTTP_METHOD_NOT_ALLOWED (405)
+ HTTP_NOT_ACCEPTABLE (406)
+ HTTP_PROXY_AUTHENTICATION_REQUIRED (407)
+ HTTP_REQUEST_TIMEOUT (408)
+ HTTP_CONFLICT (409)
+ HTTP_GONE (410)
+ HTTP_LENGTH_REQUIRED (411)
+ HTTP_PRECONDITION_FAILED (412)
+ HTTP_REQUEST_ENTITY_TOO_LARGE (413)
+ HTTP_REQUEST_URI_TOO_LARGE (414)
+ HTTP_UNSUPPORTED_MEDIA_TYPE (415)
+ HTTP_REQUEST_RANGE_NOT_SATISFIABLE (416)
+ HTTP_EXPECTATION_FAILED (417)
+ HTTP_MISDIRECTED REQUEST (421)
+ HTTP_UNPROCESSABLE_ENTITY (422)
+ HTTP_LOCKED (423)
+ HTTP_FAILED_DEPENDENCY (424)
+ HTTP_UPGRADE_REQUIRED (426)
+ HTTP_PRECONDITION_REQUIRED (428)
+ HTTP_TOO_MANY_REQUESTS (429)
+ HTTP_REQUEST_HEADER_FIELDS_TOO_LARGE (431)
+ HTTP_UNAVAILABLE_FOR_LEGAL_REASONS (451)
+
+ HTTP_INTERNAL_SERVER_ERROR (500)
+ HTTP_NOT_IMPLEMENTED (501)
+ HTTP_BAD_GATEWAY (502)
+ HTTP_SERVICE_UNAVAILABLE (503)
+ HTTP_GATEWAY_TIMEOUT (504)
+ HTTP_HTTP_VERSION_NOT_SUPPORTED (505)
+ HTTP_VARIANT_ALSO_NEGOTIATES (506)
+ HTTP_INSUFFICIENT_STORAGE (507)
+ HTTP_LOOP_DETECTED (508)
+ HTTP_NOT_EXTENDED (510)
+ HTTP_NETWORK_AUTHENTICATION_REQUIRED (511)
+
+=head1 FUNCTIONS
+
+The following additional functions are provided. Most of them are
+exported by default. The C<:is> import tag can be used to import all
+the classification functions.
+
+=over 4
+
+=item status_message( $code )
+
+The status_message() function will translate status codes to human
+readable strings. The string is the same as found in the constant
+names above. If the $code is not registered in the L<list of IANA HTTP Status
+Codes|https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml>
+then C<undef> is returned.
+
+=item is_info( $code )
+
+Return TRUE if C<$code> is an I<Informational> status code (1xx). This
+class of status code indicates a provisional response which can't have
+any content.
+
+=item is_success( $code )
+
+Return TRUE if C<$code> is a I<Successful> status code (2xx).
+
+=item is_redirect( $code )
+
+Return TRUE if C<$code> is a I<Redirection> status code (3xx). This class of
+status code indicates that further action needs to be taken by the
+user agent in order to fulfill the request.
+
+=item is_error( $code )
+
+Return TRUE if C<$code> is an I<Error> status code (4xx or 5xx). The function
+returns TRUE for both client and server error status codes.
+
+=item is_client_error( $code )
+
+Return TRUE if C<$code> is a I<Client Error> status code (4xx). This class
+of status code is intended for cases in which the client seems to have
+erred.
+
+This function is B<not> exported by default.
+
+=item is_server_error( $code )
+
+Return TRUE if C<$code> is a I<Server Error> status code (5xx). This class
+of status codes is intended for cases in which the server is aware
+that it has erred or is incapable of performing the request.
+
+This function is B<not> exported by default.
+
+=item is_cacheable_by_default( $code )
+
+Return TRUE if C<$code> indicates that a response is cacheable by default, and
+it can be reused by a cache with heuristic expiration. All other status codes
+are not cacheable by default. See L<RFC 7231 - HTTP/1.1 Semantics and Content,
+Section 6.1. Overview of Status Codes|https://tools.ietf.org/html/rfc7231#section-6.1>.
+
+This function is B<not> exported by default.
+
+=back
+
+=head1 SEE ALSO
+
+L<IANA HTTP Status Codes|https://www.iana.org/assignments/http-status-codes/http-status-codes.xhtml>
+
+=head1 BUGS
+
+For legacy reasons all the C<HTTP_> constants are exported by default
+with the prefix C<RC_>. It's recommended to use explicit imports and
+the C<:constants> tag instead of relying on this.
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 1994-2017 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.
+
+=cut
+
+__END__
+
+
+#ABSTRACT: HTTP Status code processing
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/IO/HTML.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/IO/HTML.pm
new file mode 100644
index 0000000000..5fdad2237e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/IO/HTML.pm
@@ -0,0 +1,575 @@
+#---------------------------------------------------------------------
+package IO::HTML;
+#
+# Copyright 2014 Christopher J. Madsen
+#
+# Author: Christopher J. Madsen <perl@cjmweb.net>
+# Created: 14 Jan 2012
+#
+# This program is free software; you can redistribute it and/or modify
+# it under the same terms as Perl itself.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See either the
+# GNU General Public License or the Artistic License for more details.
+#
+# ABSTRACT: Open an HTML file with automatic charset detection
+#---------------------------------------------------------------------
+
+use 5.008;
+use strict;
+use warnings;
+
+use Carp 'croak';
+use Encode 2.10 qw(decode find_encoding); # need utf-8-strict encoding
+use Exporter 5.57 'import';
+
+our $VERSION = '1.001';
+# This file is part of IO-HTML 1.001 (June 28, 2014)
+
+our $default_encoding ||= 'cp1252';
+
+our @EXPORT = qw(html_file);
+our @EXPORT_OK = qw(find_charset_in html_file_and_encoding html_outfile
+ sniff_encoding);
+
+our %EXPORT_TAGS = (
+ rw => [qw( html_file html_file_and_encoding html_outfile )],
+ all => [ @EXPORT, @EXPORT_OK ],
+);
+
+#=====================================================================
+
+
+sub html_file
+{
+ (&html_file_and_encoding)[0]; # return just the filehandle
+} # end html_file
+
+
+# Note: I made html_file and html_file_and_encoding separate functions
+# (instead of making html_file context-sensitive) because I wanted to
+# use html_file in function calls (i.e. list context) without having
+# to write "scalar html_file" all the time.
+
+sub html_file_and_encoding
+{
+ my ($filename, $options) = @_;
+
+ $options ||= {};
+
+ open(my $in, '<:raw', $filename) or croak "Failed to open $filename: $!";
+
+
+ my ($encoding, $bom) = sniff_encoding($in, $filename, $options);
+
+ if (not defined $encoding) {
+ croak "No default encoding specified"
+ unless defined($encoding = $default_encoding);
+ $encoding = find_encoding($encoding) if $options->{encoding};
+ } # end if we didn't find an encoding
+
+ binmode $in, sprintf(":encoding(%s):crlf",
+ $options->{encoding} ? $encoding->name : $encoding);
+
+ return ($in, $encoding, $bom);
+} # end html_file_and_encoding
+#---------------------------------------------------------------------
+
+
+sub html_outfile
+{
+ my ($filename, $encoding, $bom) = @_;
+
+ if (not defined $encoding) {
+ croak "No default encoding specified"
+ unless defined($encoding = $default_encoding);
+ } # end if we didn't find an encoding
+ elsif (ref $encoding) {
+ $encoding = $encoding->name;
+ }
+
+ open(my $out, ">:encoding($encoding)", $filename)
+ or croak "Failed to open $filename: $!";
+
+ print $out "\x{FeFF}" if $bom;
+
+ return $out;
+} # end html_outfile
+#---------------------------------------------------------------------
+
+
+sub sniff_encoding
+{
+ my ($in, $filename, $options) = @_;
+
+ $filename = 'file' unless defined $filename;
+ $options ||= {};
+
+ my $pos = tell $in;
+ croak "Could not seek $filename: $!" if $pos < 0;
+
+ croak "Could not read $filename: $!" unless defined read $in, my $buf, 1024;
+
+ seek $in, $pos, 0 or croak "Could not seek $filename: $!";
+
+
+ # Check for BOM:
+ my $bom;
+ my $encoding = do {
+ if ($buf =~ /^\xFe\xFF/) {
+ $bom = 2;
+ 'UTF-16BE';
+ } elsif ($buf =~ /^\xFF\xFe/) {
+ $bom = 2;
+ 'UTF-16LE';
+ } elsif ($buf =~ /^\xEF\xBB\xBF/) {
+ $bom = 3;
+ 'utf-8-strict';
+ } else {
+ find_charset_in($buf, $options); # check for <meta charset>
+ }
+ }; # end $encoding
+
+ if ($bom) {
+ seek $in, $bom, 1 or croak "Could not seek $filename: $!";
+ $bom = 1;
+ }
+ elsif (not defined $encoding) { # try decoding as UTF-8
+ my $test = decode('utf-8-strict', $buf, Encode::FB_QUIET);
+ if ($buf =~ /^(?: # nothing left over
+ | [\xC2-\xDF] # incomplete 2-byte char
+ | [\xE0-\xEF] [\x80-\xBF]? # incomplete 3-byte char
+ | [\xF0-\xF4] [\x80-\xBF]{0,2} # incomplete 4-byte char
+ )\z/x and $test =~ /[^\x00-\x7F]/) {
+ $encoding = 'utf-8-strict';
+ } # end if valid UTF-8 with at least one multi-byte character:
+ } # end if testing for UTF-8
+
+ if (defined $encoding and $options->{encoding} and not ref $encoding) {
+ $encoding = find_encoding($encoding);
+ } # end if $encoding is a string and we want an object
+
+ return wantarray ? ($encoding, $bom) : $encoding;
+} # end sniff_encoding
+
+#=====================================================================
+# Based on HTML5 8.2.2.2 Determining the character encoding:
+
+# Get attribute from current position of $_
+sub _get_attribute
+{
+ m!\G[\x09\x0A\x0C\x0D /]+!gc; # skip whitespace or /
+
+ return if /\G>/gc or not /\G(=?[^\x09\x0A\x0C\x0D =]*)/gc;
+
+ my ($name, $value) = (lc $1, '');
+
+ if (/\G[\x09\x0A\x0C\x0D ]*=[\x09\x0A\x0C\x0D ]*/gc
+ and (/\G"([^"]*)"?/gc or
+ /\G'([^']*)'?/gc or
+ /\G([^\x09\x0A\x0C\x0D >]*)/gc)) {
+ $value = lc $1;
+ } # end if attribute has value
+
+ return wantarray ? ($name, $value) : 1;
+} # end _get_attribute
+
+# Examine a meta value for a charset:
+sub _get_charset_from_meta
+{
+ for (shift) {
+ while (/charset[\x09\x0A\x0C\x0D ]*=[\x09\x0A\x0C\x0D ]*/ig) {
+ return $1 if (/\G"([^"]*)"/gc or
+ /\G'([^']*)'/gc or
+ /\G(?!['"])([^\x09\x0A\x0C\x0D ;]+)/gc);
+ }
+ } # end for value
+
+ return undef;
+} # end _get_charset_from_meta
+#---------------------------------------------------------------------
+
+
+sub find_charset_in
+{
+ for (shift) {
+ my $options = shift || {};
+ my $stop = length > 1024 ? 1024 : length; # search first 1024 bytes
+
+ my $expect_pragma = (defined $options->{need_pragma}
+ ? $options->{need_pragma} : 1);
+
+ pos() = 0;
+ while (pos() < $stop) {
+ if (/\G<!--.*?(?<=--)>/sgc) {
+ } # Skip comment
+ elsif (m!\G<meta(?=[\x09\x0A\x0C\x0D /])!gic) {
+ my ($got_pragma, $need_pragma, $charset);
+
+ while (my ($name, $value) = &_get_attribute) {
+ if ($name eq 'http-equiv' and $value eq 'content-type') {
+ $got_pragma = 1;
+ } elsif ($name eq 'content' and not defined $charset) {
+ $need_pragma = $expect_pragma
+ if defined($charset = _get_charset_from_meta($value));
+ } elsif ($name eq 'charset') {
+ $charset = $value;
+ $need_pragma = 0;
+ }
+ } # end while more attributes in this <meta> tag
+
+ if (defined $need_pragma and (not $need_pragma or $got_pragma)) {
+ $charset = 'UTF-8' if $charset =~ /^utf-?16/;
+ $charset = 'cp1252' if $charset eq 'iso-8859-1'; # people lie
+ if (my $encoding = find_encoding($charset)) {
+ return $options->{encoding} ? $encoding : $encoding->name;
+ } # end if charset is a recognized encoding
+ } # end if found charset
+ } # end elsif <meta
+ elsif (m!\G</?[a-zA-Z][^\x09\x0A\x0C\x0D >]*!gc) {
+ 1 while &_get_attribute;
+ } # end elsif some other tag
+ elsif (m{\G<[!/?][^>]*}gc) {
+ } # skip unwanted things
+ elsif (m/\G</gc) {
+ } # skip < that doesn't open anything we recognize
+
+ # Advance to the next <:
+ m/\G[^<]+/gc;
+ } # end while not at search boundary
+ } # end for string
+
+ return undef; # Couldn't find a charset
+} # end find_charset_in
+#---------------------------------------------------------------------
+
+
+# Shortcuts for people who don't like exported functions:
+*file = \&html_file;
+*file_and_encoding = \&html_file_and_encoding;
+*outfile = \&html_outfile;
+
+#=====================================================================
+# Package Return Value:
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::HTML - Open an HTML file with automatic charset detection
+
+=head1 VERSION
+
+This document describes version 1.001 of
+IO::HTML, released June 28, 2014.
+
+=head1 SYNOPSIS
+
+ use IO::HTML; # exports html_file by default
+ use HTML::TreeBuilder;
+
+ my $tree = HTML::TreeBuilder->new_from_file(
+ html_file('foo.html')
+ );
+
+ # Alternative interface:
+ open(my $in, '<:raw', 'bar.html');
+ my $encoding = IO::HTML::sniff_encoding($in, 'bar.html');
+
+=head1 DESCRIPTION
+
+IO::HTML provides an easy way to open a file containing HTML while
+automatically determining its encoding. It uses the HTML5 encoding
+sniffing algorithm specified in section 8.2.2.2 of the draft standard.
+
+The algorithm as implemented here is:
+
+=over
+
+=item 1.
+
+If the file begins with a byte order mark indicating UTF-16LE,
+UTF-16BE, or UTF-8, then that is the encoding.
+
+=item 2.
+
+If the first 1024 bytes of the file contain a C<< <meta> >> tag that
+indicates the charset, and Encode recognizes the specified charset
+name, then that is the encoding. (This portion of the algorithm is
+implemented by C<find_charset_in>.)
+
+The C<< <meta> >> tag can be in one of two formats:
+
+ <meta charset="...">
+ <meta http-equiv="Content-Type" content="...charset=...">
+
+The search is case-insensitive, and the order of attributes within the
+tag is irrelevant. Any additional attributes of the tag are ignored.
+The first matching tag with a recognized encoding ends the search.
+
+=item 3.
+
+If the first 1024 bytes of the file are valid UTF-8 (with at least 1
+non-ASCII character), then the encoding is UTF-8.
+
+=item 4.
+
+If all else fails, use the default character encoding. The HTML5
+standard suggests the default encoding should be locale dependent, but
+currently it is always C<cp1252> unless you set
+C<$IO::HTML::default_encoding> to a different value. Note:
+C<sniff_encoding> does not apply this step; only C<html_file> does
+that.
+
+=back
+
+=head1 SUBROUTINES
+
+=head2 html_file
+
+ $filehandle = html_file($filename, \%options);
+
+This function (exported by default) is the primary entry point. It
+opens the file specified by C<$filename> for reading, uses
+C<sniff_encoding> to find a suitable encoding layer, and applies it.
+It also applies the C<:crlf> layer. If the file begins with a BOM,
+the filehandle is positioned just after the BOM.
+
+The optional second argument is a hashref containing options. The
+possible keys are described under C<find_charset_in>.
+
+If C<sniff_encoding> is unable to determine the encoding, it defaults
+to C<$IO::HTML::default_encoding>, which is set to C<cp1252>
+(a.k.a. Windows-1252) by default. According to the standard, the
+default should be locale dependent, but that is not currently
+implemented.
+
+It dies if the file cannot be opened.
+
+
+=head2 html_file_and_encoding
+
+ ($filehandle, $encoding, $bom)
+ = html_file_and_encoding($filename, \%options);
+
+This function (exported only by request) is just like C<html_file>,
+but returns more information. In addition to the filehandle, it
+returns the name of the encoding used, and a flag indicating whether a
+byte order mark was found (if C<$bom> is true, the file began with a
+BOM). This may be useful if you want to write the file out again
+(especially in conjunction with the C<html_outfile> function).
+
+The optional second argument is a hashref containing options. The
+possible keys are described under C<find_charset_in>.
+
+It dies if the file cannot be opened. The result of calling it in
+scalar context is undefined.
+
+
+=head2 html_outfile
+
+ $filehandle = html_outfile($filename, $encoding, $bom);
+
+This function (exported only by request) opens C<$filename> for output
+using C<$encoding>, and writes a BOM to it if C<$bom> is true.
+If C<$encoding> is C<undef>, it defaults to C<$IO::HTML::default_encoding>.
+C<$encoding> may be either an encoding name or an Encode::Encoding object.
+
+It dies if the file cannot be opened.
+
+
+=head2 sniff_encoding
+
+ ($encoding, $bom) = sniff_encoding($filehandle, $filename, \%options);
+
+This function (exported only by request) runs the HTML5 encoding
+sniffing algorithm on C<$filehandle> (which must be seekable, and
+should have been opened in C<:raw> mode). C<$filename> is used only
+for error messages (if there's a problem using the filehandle), and
+defaults to "file" if omitted. The optional third argument is a
+hashref containing options. The possible keys are described under
+C<find_charset_in>.
+
+It returns Perl's canonical name for the encoding, which is not
+necessarily the same as the MIME or IANA charset name. It returns
+C<undef> if the encoding cannot be determined. C<$bom> is true if the
+file began with a byte order mark. In scalar context, it returns only
+C<$encoding>.
+
+The filehandle's position is restored to its original position
+(normally the beginning of the file) unless C<$bom> is true. In that
+case, the position is immediately after the BOM.
+
+Tip: If you want to run C<sniff_encoding> on a file you've already
+loaded into a string, open an in-memory file on the string, and pass
+that handle:
+
+ ($encoding, $bom) = do {
+ open(my $fh, '<', \$string); sniff_encoding($fh)
+ };
+
+(This only makes sense if C<$string> contains bytes, not characters.)
+
+
+=head2 find_charset_in
+
+ $encoding = find_charset_in($string_containing_HTML, \%options);
+
+This function (exported only by request) looks for charset information
+in a C<< <meta> >> tag in a possibly incomplete HTML document using
+the "two step" algorithm specified by HTML5. It does not look for a BOM.
+Only the first 1024 bytes of the string are checked.
+
+It returns Perl's canonical name for the encoding, which is not
+necessarily the same as the MIME or IANA charset name. It returns
+C<undef> if no charset is specified or if the specified charset is not
+recognized by the Encode module.
+
+The optional second argument is a hashref containing options. The
+following keys are recognized:
+
+=over
+
+=item C<encoding>
+
+If true, return the L<Encode::Encoding> object instead of its name.
+Defaults to false.
+
+=item C<need_pragma>
+
+If true (the default), follow the HTML5 spec and examine the
+C<content> attribute only of C<< <meta http-equiv="Content-Type" >>.
+If set to 0, relax the HTML5 spec, and look for "charset=" in the
+C<content> attribute of I<every> meta tag.
+
+=back
+
+=head1 EXPORTS
+
+By default, only C<html_file> is exported. Other functions may be
+exported on request.
+
+For people who prefer not to export functions, all functions beginning
+with C<html_> have an alias without that prefix (e.g. you can call
+C<IO::HTML::file(...)> instead of C<IO::HTML::html_file(...)>. These
+aliases are not exportable.
+
+=for Pod::Coverage
+file
+file_and_encoding
+outfile
+
+The following export tags are available:
+
+=over
+
+=item C<:all>
+
+All exportable functions.
+
+=item C<:rw>
+
+C<html_file>, C<html_file_and_encoding>, C<html_outfile>.
+
+=back
+
+=head1 SEE ALSO
+
+The HTML5 specification, section 8.2.2.2 Determining the character encoding:
+L<http://www.w3.org/TR/html5/syntax.html#determining-the-character-encoding>
+
+=head1 DIAGNOSTICS
+
+=over
+
+=item C<< Could not read %s: %s >>
+
+The specified file could not be read from for the reason specified by C<$!>.
+
+
+=item C<< Could not seek %s: %s >>
+
+The specified file could not be rewound for the reason specified by C<$!>.
+
+
+=item C<< Failed to open %s: %s >>
+
+The specified file could not be opened for reading for the reason
+specified by C<$!>.
+
+
+=item C<< No default encoding specified >>
+
+The C<sniff_encoding> algorithm didn't find an encoding to use, and
+you set C<$IO::HTML::default_encoding> to C<undef>.
+
+
+=back
+
+=head1 CONFIGURATION AND ENVIRONMENT
+
+IO::HTML requires no configuration files or environment variables.
+
+=head1 DEPENDENCIES
+
+IO::HTML has no non-core dependencies for Perl 5.8.7+. With earlier
+versions of Perl 5.8, you need to upgrade L<Encode> to at least
+version 2.10, and
+you may need to upgrade L<Exporter> to at least version
+5.57.
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+=head1 BUGS AND LIMITATIONS
+
+No bugs have been reported.
+
+=head1 AUTHOR
+
+Christopher J. Madsen S<C<< <perl AT cjmweb.net> >>>
+
+Please report any bugs or feature requests
+to S<C<< <bug-IO-HTML AT rt.cpan.org> >>>
+or through the web interface at
+L<< http://rt.cpan.org/Public/Bug/Report.html?Queue=IO-HTML >>.
+
+You can follow or contribute to IO-HTML's development at
+L<< https://github.com/madsen/io-html >>.
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Christopher J. Madsen.
+
+This is free software; you can redistribute it and/or modify it under
+the same terms as the Perl 5 programming language system itself.
+
+=head1 DISCLAIMER OF WARRANTY
+
+BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
+FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
+PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
+EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
+WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
+ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH
+YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL
+NECESSARY SERVICING, REPAIR, OR CORRECTION.
+
+IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
+REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENSE, BE
+LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL,
+OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE
+THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
+RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
+FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
+SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/IO/String.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/IO/String.pm
new file mode 100644
index 0000000000..4bc8e71960
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/IO/String.pm
@@ -0,0 +1,551 @@
+package IO::String;
+
+# Copyright 1998-2005 Gisle Aas.
+#
+# This library is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+require 5.005_03;
+use strict;
+use vars qw($VERSION $DEBUG $IO_CONSTANTS);
+$VERSION = "1.08"; # $Date: 2005/12/05 12:00:47 $
+
+use Symbol ();
+
+sub new
+{
+ my $class = shift;
+ my $self = bless Symbol::gensym(), ref($class) || $class;
+ tie *$self, $self;
+ $self->open(@_);
+ return $self;
+}
+
+sub open
+{
+ my $self = shift;
+ return $self->new(@_) unless ref($self);
+
+ if (@_) {
+ my $bufref = ref($_[0]) ? $_[0] : \$_[0];
+ $$bufref = "" unless defined $$bufref;
+ *$self->{buf} = $bufref;
+ }
+ else {
+ my $buf = "";
+ *$self->{buf} = \$buf;
+ }
+ *$self->{pos} = 0;
+ *$self->{lno} = 0;
+ return $self;
+}
+
+sub pad
+{
+ my $self = shift;
+ my $old = *$self->{pad};
+ *$self->{pad} = substr($_[0], 0, 1) if @_;
+ return "\0" unless defined($old) && length($old);
+ return $old;
+}
+
+sub dump
+{
+ require Data::Dumper;
+ my $self = shift;
+ print Data::Dumper->Dump([$self], ['*self']);
+ print Data::Dumper->Dump([*$self{HASH}], ['$self{HASH}']);
+ return;
+}
+
+sub TIEHANDLE
+{
+ print "TIEHANDLE @_\n" if $DEBUG;
+ return $_[0] if ref($_[0]);
+ my $class = shift;
+ my $self = bless Symbol::gensym(), $class;
+ $self->open(@_);
+ return $self;
+}
+
+sub DESTROY
+{
+ print "DESTROY @_\n" if $DEBUG;
+}
+
+sub close
+{
+ my $self = shift;
+ delete *$self->{buf};
+ delete *$self->{pos};
+ delete *$self->{lno};
+ undef *$self if $] eq "5.008"; # workaround for some bug
+ return 1;
+}
+
+sub opened
+{
+ my $self = shift;
+ return defined *$self->{buf};
+}
+
+sub binmode
+{
+ my $self = shift;
+ return 1 unless @_;
+ # XXX don't know much about layers yet :-(
+ return 0;
+}
+
+sub getc
+{
+ my $self = shift;
+ my $buf;
+ return $buf if $self->read($buf, 1);
+ return undef;
+}
+
+sub ungetc
+{
+ my $self = shift;
+ $self->setpos($self->getpos() - 1);
+ return 1;
+}
+
+sub eof
+{
+ my $self = shift;
+ return length(${*$self->{buf}}) <= *$self->{pos};
+}
+
+sub print
+{
+ my $self = shift;
+ if (defined $\) {
+ if (defined $,) {
+ $self->write(join($,, @_).$\);
+ }
+ else {
+ $self->write(join("",@_).$\);
+ }
+ }
+ else {
+ if (defined $,) {
+ $self->write(join($,, @_));
+ }
+ else {
+ $self->write(join("",@_));
+ }
+ }
+ return 1;
+}
+*printflush = \*print;
+
+sub printf
+{
+ my $self = shift;
+ print "PRINTF(@_)\n" if $DEBUG;
+ my $fmt = shift;
+ $self->write(sprintf($fmt, @_));
+ return 1;
+}
+
+
+my($SEEK_SET, $SEEK_CUR, $SEEK_END);
+
+sub _init_seek_constants
+{
+ if ($IO_CONSTANTS) {
+ require IO::Handle;
+ $SEEK_SET = &IO::Handle::SEEK_SET;
+ $SEEK_CUR = &IO::Handle::SEEK_CUR;
+ $SEEK_END = &IO::Handle::SEEK_END;
+ }
+ else {
+ $SEEK_SET = 0;
+ $SEEK_CUR = 1;
+ $SEEK_END = 2;
+ }
+}
+
+
+sub seek
+{
+ my($self,$off,$whence) = @_;
+ my $buf = *$self->{buf} || return 0;
+ my $len = length($$buf);
+ my $pos = *$self->{pos};
+
+ _init_seek_constants() unless defined $SEEK_SET;
+
+ if ($whence == $SEEK_SET) { $pos = $off }
+ elsif ($whence == $SEEK_CUR) { $pos += $off }
+ elsif ($whence == $SEEK_END) { $pos = $len + $off }
+ else { die "Bad whence ($whence)" }
+ print "SEEK(POS=$pos,OFF=$off,LEN=$len)\n" if $DEBUG;
+
+ $pos = 0 if $pos < 0;
+ $self->truncate($pos) if $pos > $len; # extend file
+ *$self->{pos} = $pos;
+ return 1;
+}
+
+sub pos
+{
+ my $self = shift;
+ my $old = *$self->{pos};
+ if (@_) {
+ my $pos = shift || 0;
+ my $buf = *$self->{buf};
+ my $len = $buf ? length($$buf) : 0;
+ $pos = $len if $pos > $len;
+ *$self->{pos} = $pos;
+ }
+ return $old;
+}
+
+sub getpos { shift->pos; }
+
+*sysseek = \&seek;
+*setpos = \&pos;
+*tell = \&getpos;
+
+
+
+sub getline
+{
+ my $self = shift;
+ my $buf = *$self->{buf} || return;
+ my $len = length($$buf);
+ my $pos = *$self->{pos};
+ return if $pos >= $len;
+
+ unless (defined $/) { # slurp
+ *$self->{pos} = $len;
+ return substr($$buf, $pos);
+ }
+
+ unless (length $/) { # paragraph mode
+ # XXX slow&lazy implementation using getc()
+ my $para = "";
+ my $eol = 0;
+ my $c;
+ while (defined($c = $self->getc)) {
+ if ($c eq "\n") {
+ $eol++;
+ next if $eol > 2;
+ }
+ elsif ($eol > 1) {
+ $self->ungetc($c);
+ last;
+ }
+ else {
+ $eol = 0;
+ }
+ $para .= $c;
+ }
+ return $para; # XXX wantarray
+ }
+
+ my $idx = index($$buf,$/,$pos);
+ if ($idx < 0) {
+ # return rest of it
+ *$self->{pos} = $len;
+ $. = ++ *$self->{lno};
+ return substr($$buf, $pos);
+ }
+ $len = $idx - $pos + length($/);
+ *$self->{pos} += $len;
+ $. = ++ *$self->{lno};
+ return substr($$buf, $pos, $len);
+}
+
+sub getlines
+{
+ die "getlines() called in scalar context\n" unless wantarray;
+ my $self = shift;
+ my($line, @lines);
+ push(@lines, $line) while defined($line = $self->getline);
+ return @lines;
+}
+
+sub READLINE
+{
+ goto &getlines if wantarray;
+ goto &getline;
+}
+
+sub input_line_number
+{
+ my $self = shift;
+ my $old = *$self->{lno};
+ *$self->{lno} = shift if @_;
+ return $old;
+}
+
+sub truncate
+{
+ my $self = shift;
+ my $len = shift || 0;
+ my $buf = *$self->{buf};
+ if (length($$buf) >= $len) {
+ substr($$buf, $len) = '';
+ *$self->{pos} = $len if $len < *$self->{pos};
+ }
+ else {
+ $$buf .= ($self->pad x ($len - length($$buf)));
+ }
+ return 1;
+}
+
+sub read
+{
+ my $self = shift;
+ my $buf = *$self->{buf};
+ return undef unless $buf;
+
+ my $pos = *$self->{pos};
+ my $rem = length($$buf) - $pos;
+ my $len = $_[1];
+ $len = $rem if $len > $rem;
+ return undef if $len < 0;
+ if (@_ > 2) { # read offset
+ substr($_[0],$_[2]) = substr($$buf, $pos, $len);
+ }
+ else {
+ $_[0] = substr($$buf, $pos, $len);
+ }
+ *$self->{pos} += $len;
+ return $len;
+}
+
+sub write
+{
+ my $self = shift;
+ my $buf = *$self->{buf};
+ return unless $buf;
+
+ my $pos = *$self->{pos};
+ my $slen = length($_[0]);
+ my $len = $slen;
+ my $off = 0;
+ if (@_ > 1) {
+ $len = $_[1] if $_[1] < $len;
+ if (@_ > 2) {
+ $off = $_[2] || 0;
+ die "Offset outside string" if $off > $slen;
+ if ($off < 0) {
+ $off += $slen;
+ die "Offset outside string" if $off < 0;
+ }
+ my $rem = $slen - $off;
+ $len = $rem if $rem < $len;
+ }
+ }
+ substr($$buf, $pos, $len) = substr($_[0], $off, $len);
+ *$self->{pos} += $len;
+ return $len;
+}
+
+*sysread = \&read;
+*syswrite = \&write;
+
+sub stat
+{
+ my $self = shift;
+ return unless $self->opened;
+ return 1 unless wantarray;
+ my $len = length ${*$self->{buf}};
+
+ return (
+ undef, undef, # dev, ino
+ 0666, # filemode
+ 1, # links
+ $>, # user id
+ $), # group id
+ undef, # device id
+ $len, # size
+ undef, # atime
+ undef, # mtime
+ undef, # ctime
+ 512, # blksize
+ int(($len+511)/512) # blocks
+ );
+}
+
+sub FILENO {
+ return undef; # XXX perlfunc says this means the file is closed
+}
+
+sub blocking {
+ my $self = shift;
+ my $old = *$self->{blocking} || 0;
+ *$self->{blocking} = shift if @_;
+ return $old;
+}
+
+my $notmuch = sub { return };
+
+*fileno = $notmuch;
+*error = $notmuch;
+*clearerr = $notmuch;
+*sync = $notmuch;
+*flush = $notmuch;
+*setbuf = $notmuch;
+*setvbuf = $notmuch;
+
+*untaint = $notmuch;
+*autoflush = $notmuch;
+*fcntl = $notmuch;
+*ioctl = $notmuch;
+
+*GETC = \&getc;
+*PRINT = \&print;
+*PRINTF = \&printf;
+*READ = \&read;
+*WRITE = \&write;
+*SEEK = \&seek;
+*TELL = \&getpos;
+*EOF = \&eof;
+*CLOSE = \&close;
+*BINMODE = \&binmode;
+
+
+sub string_ref
+{
+ my $self = shift;
+ return *$self->{buf};
+}
+*sref = \&string_ref;
+
+1;
+
+__END__
+
+=head1 NAME
+
+IO::String - Emulate file interface for in-core strings
+
+=head1 SYNOPSIS
+
+ use IO::String;
+ $io = IO::String->new;
+ $io = IO::String->new($var);
+ tie *IO, 'IO::String';
+
+ # read data
+ <$io>;
+ $io->getline;
+ read($io, $buf, 100);
+
+ # write data
+ print $io "string\n";
+ $io->print(@data);
+ syswrite($io, $buf, 100);
+
+ select $io;
+ printf "Some text %s\n", $str;
+
+ # seek
+ $pos = $io->getpos;
+ $io->setpos(0); # rewind
+ $io->seek(-30, -1);
+ seek($io, 0, 0);
+
+=head1 DESCRIPTION
+
+The C<IO::String> module provides the C<IO::File> interface for in-core
+strings. An C<IO::String> object can be attached to a string, and
+makes it possible to use the normal file operations for reading or
+writing data, as well as for seeking to various locations of the string.
+This is useful when you want to use a library module that only
+provides an interface to file handles on data that you have in a string
+variable.
+
+Note that perl-5.8 and better has built-in support for "in memory"
+files, which are set up by passing a reference instead of a filename
+to the open() call. The reason for using this module is that it
+makes the code backwards compatible with older versions of Perl.
+
+The C<IO::String> module provides an interface compatible with
+C<IO::File> as distributed with F<IO-1.20>, but the following methods
+are not available: new_from_fd, fdopen, format_write,
+format_page_number, format_lines_per_page, format_lines_left,
+format_name, format_top_name.
+
+The following methods are specific to the C<IO::String> class:
+
+=over 4
+
+=item $io = IO::String->new
+
+=item $io = IO::String->new( $string )
+
+The constructor returns a newly-created C<IO::String> object. It
+takes an optional argument, which is the string to read from or write
+into. If no $string argument is given, then an internal buffer
+(initially empty) is allocated.
+
+The C<IO::String> object returned is tied to itself. This means
+that you can use most Perl I/O built-ins on it too: readline, <>, getc,
+print, printf, syswrite, sysread, close.
+
+=item $io->open
+
+=item $io->open( $string )
+
+Attaches an existing IO::String object to some other $string, or
+allocates a new internal buffer (if no argument is given). The
+position is reset to 0.
+
+=item $io->string_ref
+
+Returns a reference to the string that is attached to
+the C<IO::String> object. Most useful when you let the C<IO::String>
+create an internal buffer to write into.
+
+=item $io->pad
+
+=item $io->pad( $char )
+
+Specifies the padding to use if
+the string is extended by either the seek() or truncate() methods. It
+is a single character and defaults to "\0".
+
+=item $io->pos
+
+=item $io->pos( $newpos )
+
+Yet another interface for reading and setting the current read/write
+position within the string (the normal getpos/setpos/tell/seek
+methods are also available). The pos() method always returns the
+old position, and if you pass it an argument it sets the new
+position.
+
+There is (deliberately) a difference between the setpos() and seek()
+methods in that seek() extends the string (with the specified
+padding) if you go to a location past the end, whereas setpos()
+just snaps back to the end. If truncate() is used to extend the string,
+then it works as seek().
+
+=back
+
+=head1 BUGS
+
+In Perl versions < 5.6, the TIEHANDLE interface was incomplete.
+If you use such a Perl, then seek(), tell(), eof(), fileno(), binmode() will
+not do anything on an C<IO::String> handle. See L<perltie> for
+details.
+
+=head1 SEE ALSO
+
+L<IO::File>, L<IO::Stringy>, L<perlfunc/open>
+
+=head1 COPYRIGHT
+
+Copyright 1998-2005 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/JSON/MaybeXS.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/JSON/MaybeXS.pm
new file mode 100644
index 0000000000..302b01cb65
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/JSON/MaybeXS.pm
@@ -0,0 +1,334 @@
+package JSON::MaybeXS;
+
+use strict;
+use warnings FATAL => 'all';
+use base qw(Exporter);
+
+our $VERSION = '1.004000';
+$VERSION = eval $VERSION;
+
+sub _choose_json_module {
+ return 'Cpanel::JSON::XS' if $INC{'Cpanel/JSON/XS.pm'};
+ return 'JSON::XS' if $INC{'JSON/XS.pm'};
+
+ my @err;
+
+ return 'Cpanel::JSON::XS' if eval { require Cpanel::JSON::XS; 1; };
+ push @err, "Error loading Cpanel::JSON::XS: $@";
+
+ return 'JSON::XS' if eval { require JSON::XS; 1; };
+ push @err, "Error loading JSON::XS: $@";
+
+ return 'JSON::PP' if eval { require JSON::PP; 1 };
+ push @err, "Error loading JSON::PP: $@";
+
+ die join( "\n", "Couldn't load a JSON module:", @err );
+
+}
+
+BEGIN {
+ our $JSON_Class = _choose_json_module();
+ $JSON_Class->import(qw(encode_json decode_json));
+ no strict 'refs';
+ *$_ = $JSON_Class->can($_)
+ for qw(true false);
+}
+
+our @EXPORT = qw(encode_json decode_json JSON);
+my @EXPORT_ALL = qw(is_bool);
+our @EXPORT_OK = qw(is_bool to_json from_json);
+our %EXPORT_TAGS = ( all => [ @EXPORT, @EXPORT_ALL ],
+ legacy => [ @EXPORT, @EXPORT_OK ],
+ );
+
+sub JSON () { our $JSON_Class }
+
+sub new {
+ shift;
+ my %args = @_ == 1 ? %{$_[0]} : @_;
+ my $new = (our $JSON_Class)->new;
+ $new->$_($args{$_}) for keys %args;
+ return $new;
+}
+
+use Scalar::Util ();
+
+sub is_bool {
+ die 'is_bool is not a method' if $_[1];
+
+ Scalar::Util::blessed($_[0])
+ and ($_[0]->isa('JSON::XS::Boolean')
+ or $_[0]->isa('Cpanel::JSON::XS::Boolean')
+ or $_[0]->isa('JSON::PP::Boolean'));
+}
+
+# (mostly) CopyPasta from JSON.pm version 2.90
+use Carp ();
+
+sub from_json ($@) {
+ if ( ref($_[0]) =~ /^JSON/ or $_[0] =~ /^JSON/ ) {
+ Carp::croak "from_json should not be called as a method.";
+ }
+ my $json = JSON()->new;
+
+ if (@_ == 2 and ref $_[1] eq 'HASH') {
+ my $opt = $_[1];
+ for my $method (keys %$opt) {
+ $json->$method( $opt->{$method} );
+ }
+ }
+
+ return $json->decode( $_[0] );
+}
+
+sub to_json ($@) {
+ if (
+ ref($_[0]) =~ /^JSON/
+ or (@_ > 2 and $_[0] =~ /^JSON/)
+ ) {
+ Carp::croak "to_json should not be called as a method.";
+ }
+ my $json = JSON()->new;
+
+ if (@_ == 2 and ref $_[1] eq 'HASH') {
+ my $opt = $_[1];
+ for my $method (keys %$opt) {
+ $json->$method( $opt->{$method} );
+ }
+ }
+
+ $json->encode($_[0]);
+}
+
+1;
+
+=head1 NAME
+
+JSON::MaybeXS - Use L<Cpanel::JSON::XS> with a fallback to L<JSON::XS> and L<JSON::PP>
+
+=head1 SYNOPSIS
+
+ use JSON::MaybeXS;
+
+ my $data_structure = decode_json($json_input);
+
+ my $json_output = encode_json($data_structure);
+
+ my $json = JSON()->new;
+
+ my $json_with_args = JSON::MaybeXS->new(utf8 => 1); # or { utf8 => 1 }
+
+=head1 DESCRIPTION
+
+This module first checks to see if either L<Cpanel::JSON::XS> or
+L<JSON::XS> is already loaded, in which case it uses that module. Otherwise
+it tries to load L<Cpanel::JSON::XS>, then L<JSON::XS>, then L<JSON::PP>
+in order, and either uses the first module it finds or throws an error.
+
+It then exports the C<encode_json> and C<decode_json> functions from the
+loaded module, along with a C<JSON> constant that returns the class name
+for calling C<new> on.
+
+If you're writing fresh code rather than replacing L<JSON.pm|JSON> usage, you might
+want to pass options as constructor args rather than calling mutators, so
+we provide our own C<new> method that supports that.
+
+=head1 EXPORTS
+
+C<encode_json>, C<decode_json> and C<JSON> are exported by default; C<is_bool>
+is exported on request.
+
+To import only some symbols, specify them on the C<use> line:
+
+ use JSON::MaybeXS qw(encode_json decode_json is_bool); # functions only
+
+ use JSON::MaybeXS qw(JSON); # JSON constant only
+
+To import all available sensible symbols (C<encode_json>, C<decode_json>, and
+C<is_bool>), use C<:all>:
+
+ use JSON::MaybeXS ':all';
+
+To import all symbols including those needed by legacy apps that use L<JSON::PP>:
+
+ use JSON::MaybeXS ':legacy';
+
+This imports the C<to_json> and C<from_json> symbols as well as everything in
+C<:all>. NOTE: This is to support legacy code that makes extensive
+use of C<to_json> and C<from_json> which you are not yet in a position to
+refactor. DO NOT use this import tag in new code, in order to avoid
+the crawling horrors of getting UTF-8 support subtly wrong. See the
+documentation for L<JSON> for further details.
+
+=head2 encode_json
+
+This is the C<encode_json> function provided by the selected implementation
+module, and takes a perl data structure which is serialised to JSON text.
+
+ my $json_text = encode_json($data_structure);
+
+=head2 decode_json
+
+This is the C<decode_json> function provided by the selected implementation
+module, and takes a string of JSON text to deserialise to a perl data structure.
+
+ my $data_structure = decode_json($json_text);
+
+=head2 to_json, from_json
+
+See L<JSON> for details. These are included to support legacy code
+B<only>.
+
+=head2 JSON
+
+The C<JSON> constant returns the selected implementation module's name for
+use as a class name - so:
+
+ my $json_obj = JSON()->new; # returns a Cpanel::JSON::XS or JSON::PP object
+
+and that object can then be used normally:
+
+ my $data_structure = $json_obj->decode($json_text); # etc.
+
+The use of parentheses here is optional, and only used as a hint to the reader
+that this use of C<JSON> is a I<subroutine> call, I<not> a class name.
+
+=head2 is_bool
+
+ $is_boolean = is_bool($scalar)
+
+Returns true if the passed scalar represents either C<true> or
+C<false>, two constants that act like C<1> and C<0>, respectively
+and are used to represent JSON C<true> and C<false> values in Perl.
+
+Since this is a bare sub in the various backend classes, it cannot be called as
+a class method like the other interfaces; it must be called as a function, with
+no invocant. It supports the representation used in all JSON backends.
+
+=head1 CONSTRUCTOR
+
+=head2 new
+
+With L<JSON::PP>, L<JSON::XS> and L<Cpanel::JSON::XS> you are required to call
+mutators to set options, such as:
+
+ my $json = $class->new->utf8(1)->pretty(1);
+
+Since this is a trifle irritating and noticeably un-perlish, we also offer:
+
+ my $json = JSON::MaybeXS->new(utf8 => 1, pretty => 1);
+
+which works equivalently to the above (and in the usual tradition will accept
+a hashref instead of a hash, should you so desire).
+
+The resulting object is blessed into the underlying backend, which offers (at
+least) the methods C<encode> and C<decode>.
+
+=head1 BOOLEANS
+
+To include JSON-aware booleans (C<true>, C<false>) in your data, just do:
+
+ use JSON::MaybeXS;
+ my $true = JSON()->true;
+ my $false = JSON()->false;
+
+The booleans are also available as subs or methods on JSON::MaybeXS.
+
+ use JSON::MaybeXS ();
+ my $true = JSON::MaybeXS::true;
+ my $true = JSON::MaybeXS->true;
+ my $false = JSON::MaybeXS::false;
+ my $false = JSON::MaybeXS->false;
+
+=head1 CONVERTING FROM JSON::Any
+
+L<JSON::Any> used to be the favoured compatibility layer above the various
+JSON backends, but over time has grown a lot of extra code to deal with legacy
+backends (e.g. L<JSON::Syck>) that are no longer needed. This is a rough guide of translating such code:
+
+Change code from:
+
+ use JSON::Any;
+ my $json = JSON::Any->new->objToJson($data); # or to_json($data), or Dump($data)
+
+to:
+
+ use JSON::MaybeXS;
+ my $json = encode_json($data);
+
+
+Change code from:
+
+ use JSON::Any;
+ my $data = JSON::Any->new->jsonToObj($json); # or from_json($json), or Load($json)
+
+to:
+
+ use JSON::MaybeXS;
+ my $json = decode_json($data);
+
+=head1 CAVEATS
+
+The C<new()> method in this module is technically a factory, not a
+constructor, because the objects it returns will I<NOT> be blessed into the
+C<JSON::MaybeXS> class.
+
+If you are using an object returned by this module as a Moo(se) attribute,
+this type constraint code:
+
+ is 'json' => ( isa => 'JSON::MaybeXS' );
+
+will I<NOT> do what you expect. Instead, either rely on the C<JSON> class
+constant described above, as so:
+
+ is 'json' => ( isa => JSON::MaybeXS::JSON() );
+
+Alternatively, you can use duck typing:
+
+ use Moose::Util::TypeConstraints 'duck_type';
+ is 'json' => ( isa => Object , duck_type([qw/ encode decode /]));
+
+=head1 INSTALLATION
+
+At installation time, F<Makefile.PL> will attempt to determine if you have a
+working compiler available, and therefore whether you are able to run XS code.
+If so, L<Cpanel::JSON::XS> will be added to the prerequisite list, unless
+L<JSON::XS> is already installed at a high enough version. L<JSON::XS> may
+also be upgraded to fix any incompatibility issues.
+
+Because running XS code is not mandatory and L<JSON::PP> (which is in perl
+core) is used as a fallback backend, this module is safe to be used in a suite
+of code that is fatpacked or installed into a restricted-resource environment.
+
+You can also prevent any XS dependencies from being installed by setting
+C<PUREPERL_ONLY=1> in F<Makefile.PL> options (or in the C<PERL_MM_OPT>
+environment variable), or using the C<--pp> or C<--pureperl> flags with the
+L<cpanminus client|cpanm>.
+
+=head1 AUTHOR
+
+mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
+
+=head1 CONTRIBUTORS
+
+=over 4
+
+=item * Clinton Gormley <drtech@cpan.org>
+
+=item * Karen Etheridge <ether@cpan.org>
+
+=item * Kieren Diment <diment@gmail.com>
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright (c) 2013 the C<JSON::MaybeXS> L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm
new file mode 100644
index 0000000000..12bf7a95f8
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP.pm
@@ -0,0 +1,671 @@
+package LWP;
+
+our $VERSION = '6.37';
+
+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
+<URL: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 E<lt>head> section of HTML documents.
+
+=item *
+
+B<proxy> and B<no_proxy> specify if and when to go through
+a proxy server. <URL: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 $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 $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 a "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
new file mode 100644
index 0000000000..d33e4af2e4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Basic.pm
@@ -0,0 +1,68 @@
+package LWP::Authen::Basic;
+
+use strict;
+
+our $VERSION = '6.37';
+
+require MIME::Base64;
+
+sub auth_header {
+ my($class, $user, $pass) = @_;
+ return "Basic " . MIME::Base64::encode("$user:$pass", "");
+}
+
+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;
+
+ if (!$proxy && !$request->header($auth_header) && $ua->credentials($host_port, $realm)) {
+ # we can make sure this handler applies and retry
+ add_path($h, $url->path);
+ 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
new file mode 100644
index 0000000000..2e11ac638b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Digest.pm
@@ -0,0 +1,77 @@
+package LWP::Authen::Digest;
+
+use strict;
+use base 'LWP::Authen::Basic';
+
+our $VERSION = '6.37';
+
+require Digest::MD5;
+
+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);
+ if($request->method =~ /^(?:POST|PUT)$/) {
+ $md5->add($request->content);
+ my $content = $md5->hexdigest;
+ $md5->reset;
+ $md5->add(join(":", @digest[0..1], $content));
+ $md5->reset;
+ $resp{"message-digest"} = $md5->hexdigest;
+ push(@order, "message-digest");
+ }
+ push(@order, "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
new file mode 100644
index 0000000000..b4eaad1eaa
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Authen/Ntlm.pm
@@ -0,0 +1,183 @@
+package LWP::Authen::Ntlm;
+
+use strict;
+
+our $VERSION = '6.37';
+
+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 Mime::Base64, which Bush's Authen::NTLM makes use of. Therefore, it is
+necessary to ensure that your Mime::Base64 module supports exporting of the
+encode_base64 and 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 "keep_alive=>1" option to the 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 HTTP::Request object's authorization_basic() method to set
+the credentials. Note, too, that the '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
new file mode 100644
index 0000000000..d4cfc66e26
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/ConnCache.pm
@@ -0,0 +1,350 @@
+package LWP::ConnCache;
+
+use strict;
+
+our $VERSION = '6.37';
+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
+initialize 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
+"http" or "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 ($conn, $type, $key, $deposit_time) as arguments.
+
+Shortcuts: If the $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
new file mode 100644
index 0000000000..c93a80ade3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug.pm
@@ -0,0 +1,112 @@
+package LWP::Debug; # legacy
+
+our $VERSION = '6.37';
+
+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
new file mode 100644
index 0000000000..0644644616
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Debug/TraceHTTP.pm
@@ -0,0 +1,29 @@
+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 base 'LWP::Protocol::http';
+
+our $VERSION = '6.37';
+
+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
new file mode 100644
index 0000000000..f35cdf3426
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/DebugFile.pm
@@ -0,0 +1,7 @@
+package LWP::DebugFile;
+
+our $VERSION = '6.37';
+
+# legacy stub
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MediaTypes.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MediaTypes.pm
new file mode 100644
index 0000000000..8c2a8aee33
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MediaTypes.pm
@@ -0,0 +1,280 @@
+package LWP::MediaTypes;
+
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT = qw(guess_media_type media_suffix);
+@EXPORT_OK = qw(add_type add_encoding read_media_types);
+$VERSION = "6.02";
+
+use strict;
+
+# note: These hashes will also be filled with the entries found in
+# the 'media.types' file.
+
+my %suffixType = (
+ 'txt' => 'text/plain',
+ 'html' => 'text/html',
+ 'gif' => 'image/gif',
+ 'jpg' => 'image/jpeg',
+ 'xml' => 'text/xml',
+);
+
+my %suffixExt = (
+ 'text/plain' => 'txt',
+ 'text/html' => 'html',
+ 'image/gif' => 'gif',
+ 'image/jpeg' => 'jpg',
+ 'text/xml' => 'xml',
+);
+
+#XXX: there should be some way to define this in the media.types files.
+my %suffixEncoding = (
+ 'Z' => 'compress',
+ 'gz' => 'gzip',
+ 'hqx' => 'x-hqx',
+ 'uu' => 'x-uuencode',
+ 'z' => 'x-pack',
+ 'bz2' => 'x-bzip2',
+);
+
+read_media_types();
+
+
+
+sub guess_media_type
+{
+ my($file, $header) = @_;
+ return undef unless defined $file;
+
+ my $fullname;
+ if (ref($file)) {
+ # assume URI object
+ $file = $file->path;
+ #XXX should handle non http:, file: or ftp: URIs differently
+ }
+ else {
+ $fullname = $file; # enable peek at actual file
+ }
+
+ my @encoding = ();
+ my $ct = undef;
+ for (file_exts($file)) {
+ # first check this dot part as encoding spec
+ if (exists $suffixEncoding{$_}) {
+ unshift(@encoding, $suffixEncoding{$_});
+ next;
+ }
+ if (exists $suffixEncoding{lc $_}) {
+ unshift(@encoding, $suffixEncoding{lc $_});
+ next;
+ }
+
+ # check content-type
+ if (exists $suffixType{$_}) {
+ $ct = $suffixType{$_};
+ last;
+ }
+ if (exists $suffixType{lc $_}) {
+ $ct = $suffixType{lc $_};
+ last;
+ }
+
+ # don't know nothing about this dot part, bail out
+ last;
+ }
+ unless (defined $ct) {
+ # Take a look at the file
+ if (defined $fullname) {
+ $ct = (-T $fullname) ? "text/plain" : "application/octet-stream";
+ }
+ else {
+ $ct = "application/octet-stream";
+ }
+ }
+
+ if ($header) {
+ $header->header('Content-Type' => $ct);
+ $header->header('Content-Encoding' => \@encoding) if @encoding;
+ }
+
+ wantarray ? ($ct, @encoding) : $ct;
+}
+
+
+sub media_suffix {
+ if (!wantarray && @_ == 1 && $_[0] !~ /\*/) {
+ return $suffixExt{lc $_[0]};
+ }
+ my(@type) = @_;
+ my(@suffix, $ext, $type);
+ foreach (@type) {
+ if (s/\*/.*/) {
+ while(($ext,$type) = each(%suffixType)) {
+ push(@suffix, $ext) if $type =~ /^$_$/i;
+ }
+ }
+ else {
+ my $ltype = lc $_;
+ while(($ext,$type) = each(%suffixType)) {
+ push(@suffix, $ext) if lc $type eq $ltype;
+ }
+ }
+ }
+ wantarray ? @suffix : $suffix[0];
+}
+
+
+sub file_exts
+{
+ require File::Basename;
+ my @parts = reverse split(/\./, File::Basename::basename($_[0]));
+ pop(@parts); # never consider first part
+ @parts;
+}
+
+
+sub add_type
+{
+ my($type, @exts) = @_;
+ for my $ext (@exts) {
+ $ext =~ s/^\.//;
+ $suffixType{$ext} = $type;
+ }
+ $suffixExt{lc $type} = $exts[0] if @exts;
+}
+
+
+sub add_encoding
+{
+ my($type, @exts) = @_;
+ for my $ext (@exts) {
+ $ext =~ s/^\.//;
+ $suffixEncoding{$ext} = $type;
+ }
+}
+
+
+sub read_media_types
+{
+ my(@files) = @_;
+
+ local($/, $_) = ("\n", undef); # ensure correct $INPUT_RECORD_SEPARATOR
+
+ my @priv_files = ();
+ push(@priv_files, "$ENV{HOME}/.media.types", "$ENV{HOME}/.mime.types")
+ if defined $ENV{HOME}; # Some doesn't have a home (for instance Win32)
+
+ # Try to locate "media.types" file, and initialize %suffixType from it
+ my $typefile;
+ unless (@files) {
+ @files = map {"$_/LWP/media.types"} @INC;
+ push @files, @priv_files;
+ }
+ for $typefile (@files) {
+ local(*TYPE);
+ open(TYPE, $typefile) || next;
+ while (<TYPE>) {
+ next if /^\s*#/; # comment line
+ next if /^\s*$/; # blank line
+ s/#.*//; # remove end-of-line comments
+ my($type, @exts) = split(' ', $_);
+ add_type($type, @exts);
+ }
+ close(TYPE);
+ }
+}
+
+1;
+
+
+__END__
+
+=head1 NAME
+
+LWP::MediaTypes - guess media type for a file or a URL
+
+=head1 SYNOPSIS
+
+ use LWP::MediaTypes qw(guess_media_type);
+ $type = guess_media_type("/tmp/foo.gif");
+
+=head1 DESCRIPTION
+
+This module provides functions for handling media (also known as
+MIME) types and encodings. The mapping from file extensions to media
+types is defined by the F<media.types> file. If the F<~/.media.types>
+file exists it is used instead.
+For backwards compatibility we will also look for F<~/.mime.types>.
+
+The following functions are exported by default:
+
+=over 4
+
+=item guess_media_type( $filename )
+
+=item guess_media_type( $uri )
+
+=item guess_media_type( $filename_or_uri, $header_to_modify )
+
+This function tries to guess media type and encoding for a file or a URI.
+It returns the content type, which is a string like C<"text/html">.
+In array context it also returns any content encodings applied (in the
+order used to encode the file). You can pass a URI object
+reference, instead of the file name.
+
+If the type can not be deduced from looking at the file name,
+then guess_media_type() will let the C<-T> Perl operator take a look.
+If this works (and C<-T> returns a TRUE value) then we return
+I<text/plain> as the type, otherwise we return
+I<application/octet-stream> as the type.
+
+The optional second argument should be a reference to a HTTP::Headers
+object or any object that implements the $obj->header method in a
+similar way. When it is present the values of the
+'Content-Type' and 'Content-Encoding' will be set for this header.
+
+=item media_suffix( $type, ... )
+
+This function will return all suffixes that can be used to denote the
+specified media type(s). Wildcard types can be used. In a scalar
+context it will return the first suffix found. Examples:
+
+ @suffixes = media_suffix('image/*', 'audio/basic');
+ $suffix = media_suffix('text/html');
+
+=back
+
+The following functions are only exported by explicit request:
+
+=over 4
+
+=item add_type( $type, @exts )
+
+Associate a list of file extensions with the given media type.
+Example:
+
+ add_type("x-world/x-vrml" => qw(wrl vrml));
+
+=item add_encoding( $type, @ext )
+
+Associate a list of file extensions with an encoding type.
+Example:
+
+ add_encoding("x-gzip" => "gz");
+
+=item read_media_types( @files )
+
+Parse media types files and add the type mappings found there.
+Example:
+
+ read_media_types("conf/mime.types");
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 1995-1999 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/LWP/MemberMixin.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MemberMixin.pm
new file mode 100644
index 0000000000..4ed9053cbc
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/MemberMixin.pm
@@ -0,0 +1,48 @@
+package LWP::MemberMixin;
+
+our $VERSION = '6.37';
+
+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 base 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
new file mode 100644
index 0000000000..f5966ab1c1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol.pm
@@ -0,0 +1,313 @@
+package LWP::Protocol;
+
+use base 'LWP::MemberMixin';
+
+our $VERSION = '6.37';
+
+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 base 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 request()
+method which is used to service a request. The overridden method can
+make use of the collect() function 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
new file mode 100644
index 0000000000..1f6bd0d91b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/cpan.pm
@@ -0,0 +1,72 @@
+package LWP::Protocol::cpan;
+
+use strict;
+
+use base qw(LWP::Protocol);
+
+our $VERSION = '6.37';
+
+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
new file mode 100644
index 0000000000..8460f05be9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/data.pm
@@ -0,0 +1,52 @@
+package LWP::Protocol::data;
+
+# Implements access to data:-URLs as specified in RFC 2397
+
+use strict;
+
+our $VERSION = '6.37';
+
+require HTTP::Response;
+require HTTP::Status;
+
+use base 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
new file mode 100644
index 0000000000..01c14eeafa
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/file.pm
@@ -0,0 +1,147 @@
+package LWP::Protocol::file;
+
+use base qw(LWP::Protocol);
+
+use strict;
+
+our $VERSION = '6.37';
+
+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
new file mode 100644
index 0000000000..d45a877f59
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/ftp.pm
@@ -0,0 +1,555 @@
+package LWP::Protocol::ftp;
+
+# Implementation of the ftp protocol (RFC 959). We let the Net::FTP
+# package do all the dirty work.
+use base qw(LWP::Protocol);
+use strict;
+
+our $VERSION = '6.37';
+
+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 base 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
new file mode 100644
index 0000000000..6fd6ff710b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/gopher.pm
@@ -0,0 +1,213 @@
+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.37';
+
+require HTTP::Response;
+require HTTP::Status;
+require IO::Socket;
+require IO::Select;
+
+use base 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
new file mode 100644
index 0000000000..ec53e23d95
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/http.pm
@@ -0,0 +1,523 @@
+package LWP::Protocol::http;
+
+use strict;
+
+our $VERSION = '6.37';
+
+require HTTP::Response;
+require HTTP::Status;
+require Net::HTTP;
+
+use base 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
new file mode 100644
index 0000000000..b7645deee6
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/loopback.pm
@@ -0,0 +1,27 @@
+package LWP::Protocol::loopback;
+
+use strict;
+
+our $VERSION = '6.37';
+
+require HTTP::Response;
+
+use base 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
new file mode 100644
index 0000000000..d970edafbe
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/mailto.pm
@@ -0,0 +1,184 @@
+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.37';
+
+use base 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
new file mode 100644
index 0000000000..3cbde3f4e0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nntp.pm
@@ -0,0 +1,150 @@
+package LWP::Protocol::nntp;
+
+# Implementation of the Network News Transfer Protocol (RFC 977)
+
+use base qw(LWP::Protocol);
+
+our $VERSION = '6.37';
+
+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
new file mode 100644
index 0000000000..32f09579bf
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Protocol/nogo.pm
@@ -0,0 +1,25 @@
+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.37';
+
+require HTTP::Response;
+require HTTP::Status;
+use base 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
new file mode 100644
index 0000000000..a418fe32fe
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/RobotUA.pm
@@ -0,0 +1,312 @@
+package LWP::RobotUA;
+
+use base qw(LWP::UserAgent);
+
+our $VERSION = '6.37';
+
+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<URL: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
+C<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
new file mode 100644
index 0000000000..f1b91b13ca
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/Simple.pm
@@ -0,0 +1,267 @@
+package LWP::Simple;
+
+use strict;
+
+our $VERSION = '6.37';
+
+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
new file mode 100644
index 0000000000..58f09e0b2a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/UserAgent.pm
@@ -0,0 +1,2011 @@
+package LWP::UserAgent;
+
+use strict;
+
+use base qw(LWP::MemberMixin);
+
+use Carp ();
+use HTTP::Request ();
+use HTTP::Response ();
+use HTTP::Date ();
+
+use LWP ();
+use LWP::Protocol ();
+
+use Scalar::Util qw(blessed);
+use Try::Tiny qw(try catch);
+
+our $VERSION = '6.37';
+
+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}) {
+ $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)
+ {
+ 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;
+ }
+ return $class->authenticate($self, $proxy, $challenge, $response,
+ $request, $arg, $size);
+ }
+ 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 _has_raw_content {
+ my $self = shift;
+ shift; # drop url
+
+ # taken from HTTP::Request::Common::request_type_with_data
+ my $content;
+ $content = shift if @_ and ref $_[0];
+ my($k, $v);
+ while (($k,$v) = splice(@_, 0, 2)) {
+ if (lc($k) eq 'content') {
+ $content = $v;
+ }
+ }
+
+ # We were given Content => 'string' ...
+ if (defined $content && ! ref ($content)) {
+ return 1;
+ }
+
+ return;
+}
+
+sub _maybe_copy_default_content_type {
+ my ($self, $req, @parameters) = @_;
+
+ # If we have a default Content-Type and someone passes in a POST/PUT
+ # with Content => 'some-string-value', use that Content-Type instead
+ # of x-www-form-urlencoded
+ my $ct = $self->default_header('Content-Type');
+ return unless defined $ct && $self->_has_raw_content(@parameters);
+
+ $req->header('Content-Type' => $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 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;
+ }
+
+ return keys %{$self->{ssl_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 { $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") {
+ while (my($k, $v) = each %$init) {
+ $spec{$k} = $v;
+ }
+ }
+ $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) = @_;
+
+ 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) );
+ }
+ }
+ my $tmpfile = "$file-$$";
+
+ my $response = $self->request($request, $tmpfile);
+ if ( $response->header('X-Died') ) {
+ die $response->header('X-Died');
+ }
+
+ # Only fetching a fresh copy of the 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
+ if ( -e $file ) {
+ # Some DOSish systems fail to rename if the target exists
+ chmod 0777, $file;
+ unlink $file;
+ }
+ rename( $tmpfile, $file )
+ or die "Cannot rename '$tmpfile' to '$file': $!\n";
+
+ # make sure the file has the same last modification time
+ if ( my $lm = $response->last_modified ) {
+ utime $lm, $lm, $file;
+ }
+ }
+ }
+ # 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($k,$v);
+ while(($k, $v) = each %ENV) {
+ 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);
+ 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;
+ $ua->timeout(10);
+ $ua->env_proxy;
+
+ my $response = $ua->get('http://search.cpan.org/');
+
+ if ($response->is_success) {
+ print $response->decoded_content; # or whatever
+ }
+ 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/#.###"
+ from undef
+ conn_cache undef
+ cookie_jar undef
+ default_headers HTTP::Headers->new
+ local_address undef
+ ssl_opts { verify_hostname => 1 }
+ max_size undef
+ max_redirect 7
+ parse_head 1
+ protocols_allowed undef
+ protocols_forbidden undef
+ requests_redirectable ['GET', 'HEAD']
+ timeout 180
+ proxy undef
+ no_proxy []
+
+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 is passed in, then a 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.
+
+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:
+
+=over
+
+=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_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 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_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_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_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_handlers(); # 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 $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 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 $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 die(). The
+exception message will show up as the "X-Died" header field in the
+response returned by the get() function.
+
+=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.
+
+The return value is an L<HTTP::Response> object.
+
+=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 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/LWP/media.types b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/media.types
new file mode 100644
index 0000000000..6a90929c0d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/LWP/media.types
@@ -0,0 +1,1479 @@
+# This file maps Internet media types to unique file extension(s).
+# Although created for httpd, this file is used by many software systems
+# and has been placed in the public domain for unlimited redisribution.
+#
+# The table below contains both registered and (common) unregistered types.
+# A type that has no unique extension can be ignored -- they are listed
+# here to guide configurations toward known types and to make it easier to
+# identify "new" types. File extensions are also commonly used to indicate
+# content languages and encodings, so choose them carefully.
+#
+# Internet media types should be registered as described in RFC 4288.
+# The registry is at <http://www.iana.org/assignments/media-types/>.
+#
+# MIME type (lowercased) Extensions
+# ============================================ ==========
+# application/1d-interleaved-parityfec
+# application/3gpp-ims+xml
+# application/activemessage
+application/andrew-inset ez
+# application/applefile
+application/applixware aw
+application/atom+xml atom
+application/atomcat+xml atomcat
+# application/atomicmail
+application/atomsvc+xml atomsvc
+# application/auth-policy+xml
+# application/batch-smtp
+# application/beep+xml
+# application/cals-1840
+application/ccxml+xml ccxml
+application/cdmi-capability cdmia
+application/cdmi-container cdmic
+application/cdmi-domain cdmid
+application/cdmi-object cdmio
+application/cdmi-queue cdmiq
+# application/cea-2018+xml
+# application/cellml+xml
+# application/cfw
+# application/cnrp+xml
+# application/commonground
+# application/conference-info+xml
+# application/cpl+xml
+# application/csta+xml
+# application/cstadata+xml
+application/cu-seeme cu
+# application/cybercash
+application/davmount+xml davmount
+# application/dca-rft
+# application/dec-dx
+# application/dialog-info+xml
+# application/dicom
+# application/dns
+# application/dskpp+xml
+application/dssc+der dssc
+application/dssc+xml xdssc
+# application/dvcs
+application/ecmascript ecma
+# application/edi-consent
+# application/edi-x12
+# application/edifact
+application/emma+xml emma
+# application/epp+xml
+application/epub+zip epub
+# application/eshop
+# application/example
+application/exi exi
+# application/fastinfoset
+# application/fastsoap
+# application/fits
+application/font-tdpfr pfr
+# application/framework-attributes+xml
+# application/h224
+# application/held+xml
+# application/http
+application/hyperstudio stk
+# application/ibe-key-request+xml
+# application/ibe-pkg-reply+xml
+# application/ibe-pp-data
+# application/iges
+# application/im-iscomposing+xml
+# application/index
+# application/index.cmd
+# application/index.obj
+# application/index.response
+# application/index.vnd
+# application/iotp
+application/ipfix ipfix
+# application/ipp
+# application/isup
+application/java-archive jar
+application/java-serialized-object ser
+application/java-vm class
+application/javascript js
+application/json json
+# application/kpml-request+xml
+# application/kpml-response+xml
+application/lost+xml lostxml
+application/mac-binhex40 hqx
+application/mac-compactpro cpt
+# application/macwriteii
+application/mads+xml mads
+application/marc mrc
+application/marcxml+xml mrcx
+application/mathematica ma nb mb
+# application/mathml-content+xml
+# application/mathml-presentation+xml
+application/mathml+xml mathml
+# application/mbms-associated-procedure-description+xml
+# application/mbms-deregister+xml
+# application/mbms-envelope+xml
+# application/mbms-msk+xml
+# application/mbms-msk-response+xml
+# application/mbms-protection-description+xml
+# application/mbms-reception-report+xml
+# application/mbms-register+xml
+# application/mbms-register-response+xml
+# application/mbms-user-service-description+xml
+application/mbox mbox
+# application/media_control+xml
+application/mediaservercontrol+xml mscml
+application/metalink4+xml meta4
+application/mets+xml mets
+# application/mikey
+application/mods+xml mods
+# application/moss-keys
+# application/moss-signature
+# application/mosskey-data
+# application/mosskey-request
+application/mp21 m21 mp21
+application/mp4 mp4s
+# application/mpeg4-generic
+# application/mpeg4-iod
+# application/mpeg4-iod-xmt
+# application/msc-ivr+xml
+# application/msc-mixer+xml
+application/msword doc dot
+application/mxf mxf
+# application/nasdata
+# application/news-checkgroups
+# application/news-groupinfo
+# application/news-transmission
+# application/nss
+# application/ocsp-request
+# application/ocsp-response
+application/octet-stream bin dms lha lrf lzh so iso dmg dist distz pkg bpk dump elc deploy
+application/oda oda
+application/oebps-package+xml opf
+application/ogg ogx
+application/onenote onetoc onetoc2 onetmp onepkg
+# application/parityfec
+application/patch-ops-error+xml xer
+application/pdf pdf
+application/pgp-encrypted pgp
+# application/pgp-keys
+application/pgp-signature asc sig
+application/pics-rules prf
+# application/pidf+xml
+# application/pidf-diff+xml
+application/pkcs10 p10
+application/pkcs7-mime p7m p7c
+application/pkcs7-signature p7s
+application/pkcs8 p8
+application/pkix-attr-cert ac
+application/pkix-cert cer
+application/pkix-crl crl
+application/pkix-pkipath pkipath
+application/pkixcmp pki
+application/pls+xml pls
+# application/poc-settings+xml
+application/postscript ai eps ps
+# application/prs.alvestrand.titrax-sheet
+application/prs.cww cww
+# application/prs.nprend
+# application/prs.plucker
+# application/prs.rdf-xml-crypt
+# application/prs.xsf+xml
+application/pskc+xml pskcxml
+# application/qsig
+application/rdf+xml rdf
+application/reginfo+xml rif
+application/relax-ng-compact-syntax rnc
+# application/remote-printing
+application/resource-lists+xml rl
+application/resource-lists-diff+xml rld
+# application/riscos
+# application/rlmi+xml
+application/rls-services+xml rs
+application/rsd+xml rsd
+application/rss+xml rss
+application/rtf rtf
+# application/rtx
+# application/samlassertion+xml
+# application/samlmetadata+xml
+application/sbml+xml sbml
+application/scvp-cv-request scq
+application/scvp-cv-response scs
+application/scvp-vp-request spq
+application/scvp-vp-response spp
+application/sdp sdp
+# application/set-payment
+application/set-payment-initiation setpay
+# application/set-registration
+application/set-registration-initiation setreg
+# application/sgml
+# application/sgml-open-catalog
+application/shf+xml shf
+# application/sieve
+# application/simple-filter+xml
+# application/simple-message-summary
+# application/simplesymbolcontainer
+# application/slate
+# application/smil
+application/smil+xml smi smil
+# application/soap+fastinfoset
+# application/soap+xml
+application/sparql-query rq
+application/sparql-results+xml srx
+# application/spirits-event+xml
+application/srgs gram
+application/srgs+xml grxml
+application/sru+xml sru
+application/ssml+xml ssml
+# application/tamp-apex-update
+# application/tamp-apex-update-confirm
+# application/tamp-community-update
+# application/tamp-community-update-confirm
+# application/tamp-error
+# application/tamp-sequence-adjust
+# application/tamp-sequence-adjust-confirm
+# application/tamp-status-query
+# application/tamp-status-response
+# application/tamp-update
+# application/tamp-update-confirm
+application/tei+xml tei teicorpus
+application/thraud+xml tfi
+# application/timestamp-query
+# application/timestamp-reply
+application/timestamped-data tsd
+# application/tve-trigger
+# application/ulpfec
+# application/vemmi
+# application/vividence.scriptfile
+# application/vnd.3gpp.bsf+xml
+application/vnd.3gpp.pic-bw-large plb
+application/vnd.3gpp.pic-bw-small psb
+application/vnd.3gpp.pic-bw-var pvb
+# application/vnd.3gpp.sms
+# application/vnd.3gpp2.bcmcsinfo+xml
+# application/vnd.3gpp2.sms
+application/vnd.3gpp2.tcap tcap
+application/vnd.3m.post-it-notes pwn
+application/vnd.accpac.simply.aso aso
+application/vnd.accpac.simply.imp imp
+application/vnd.acucobol acu
+application/vnd.acucorp atc acutc
+application/vnd.adobe.air-application-installer-package+zip air
+application/vnd.adobe.fxp fxp fxpl
+# application/vnd.adobe.partial-upload
+application/vnd.adobe.xdp+xml xdp
+application/vnd.adobe.xfdf xfdf
+# application/vnd.aether.imp
+# application/vnd.ah-barcode
+application/vnd.ahead.space ahead
+application/vnd.airzip.filesecure.azf azf
+application/vnd.airzip.filesecure.azs azs
+application/vnd.amazon.ebook azw
+application/vnd.americandynamics.acc acc
+application/vnd.amiga.ami ami
+# application/vnd.amundsen.maze+xml
+application/vnd.android.package-archive apk
+application/vnd.anser-web-certificate-issue-initiation cii
+application/vnd.anser-web-funds-transfer-initiation fti
+application/vnd.antix.game-component atx
+application/vnd.apple.installer+xml mpkg
+application/vnd.apple.mpegurl m3u8
+# application/vnd.arastra.swi
+application/vnd.aristanetworks.swi swi
+application/vnd.audiograph aep
+# application/vnd.autopackage
+# application/vnd.avistar+xml
+application/vnd.blueice.multipass mpm
+# application/vnd.bluetooth.ep.oob
+application/vnd.bmi bmi
+application/vnd.businessobjects rep
+# application/vnd.cab-jscript
+# application/vnd.canon-cpdl
+# application/vnd.canon-lips
+# application/vnd.cendio.thinlinc.clientconf
+application/vnd.chemdraw+xml cdxml
+application/vnd.chipnuts.karaoke-mmd mmd
+application/vnd.cinderella cdy
+# application/vnd.cirpack.isdn-ext
+application/vnd.claymore cla
+application/vnd.cloanto.rp9 rp9
+application/vnd.clonk.c4group c4g c4d c4f c4p c4u
+application/vnd.cluetrust.cartomobile-config c11amc
+application/vnd.cluetrust.cartomobile-config-pkg c11amz
+# application/vnd.commerce-battelle
+application/vnd.commonspace csp
+application/vnd.contact.cmsg cdbcmsg
+application/vnd.cosmocaller cmc
+application/vnd.crick.clicker clkx
+application/vnd.crick.clicker.keyboard clkk
+application/vnd.crick.clicker.palette clkp
+application/vnd.crick.clicker.template clkt
+application/vnd.crick.clicker.wordbank clkw
+application/vnd.criticaltools.wbs+xml wbs
+application/vnd.ctc-posml pml
+# application/vnd.ctct.ws+xml
+# application/vnd.cups-pdf
+# application/vnd.cups-postscript
+application/vnd.cups-ppd ppd
+# application/vnd.cups-raster
+# application/vnd.cups-raw
+application/vnd.curl.car car
+application/vnd.curl.pcurl pcurl
+# application/vnd.cybank
+application/vnd.data-vision.rdz rdz
+application/vnd.dece.data uvf uvvf uvd uvvd
+application/vnd.dece.ttml+xml uvt uvvt
+application/vnd.dece.unspecified uvx uvvx
+application/vnd.denovo.fcselayout-link fe_launch
+# application/vnd.dir-bi.plate-dl-nosuffix
+application/vnd.dna dna
+application/vnd.dolby.mlp mlp
+# application/vnd.dolby.mobile.1
+# application/vnd.dolby.mobile.2
+application/vnd.dpgraph dpg
+application/vnd.dreamfactory dfac
+application/vnd.dvb.ait ait
+# application/vnd.dvb.dvbj
+# application/vnd.dvb.esgcontainer
+# application/vnd.dvb.ipdcdftnotifaccess
+# application/vnd.dvb.ipdcesgaccess
+# application/vnd.dvb.ipdcesgaccess2
+# application/vnd.dvb.ipdcesgpdd
+# application/vnd.dvb.ipdcroaming
+# application/vnd.dvb.iptv.alfec-base
+# application/vnd.dvb.iptv.alfec-enhancement
+# application/vnd.dvb.notif-aggregate-root+xml
+# application/vnd.dvb.notif-container+xml
+# application/vnd.dvb.notif-generic+xml
+# application/vnd.dvb.notif-ia-msglist+xml
+# application/vnd.dvb.notif-ia-registration-request+xml
+# application/vnd.dvb.notif-ia-registration-response+xml
+# application/vnd.dvb.notif-init+xml
+# application/vnd.dvb.pfr
+application/vnd.dvb.service svc
+# application/vnd.dxr
+application/vnd.dynageo geo
+# application/vnd.easykaraoke.cdgdownload
+# application/vnd.ecdis-update
+application/vnd.ecowin.chart mag
+# application/vnd.ecowin.filerequest
+# application/vnd.ecowin.fileupdate
+# application/vnd.ecowin.series
+# application/vnd.ecowin.seriesrequest
+# application/vnd.ecowin.seriesupdate
+# application/vnd.emclient.accessrequest+xml
+application/vnd.enliven nml
+application/vnd.epson.esf esf
+application/vnd.epson.msf msf
+application/vnd.epson.quickanime qam
+application/vnd.epson.salt slt
+application/vnd.epson.ssf ssf
+# application/vnd.ericsson.quickcall
+application/vnd.eszigno3+xml es3 et3
+# application/vnd.etsi.aoc+xml
+# application/vnd.etsi.cug+xml
+# application/vnd.etsi.iptvcommand+xml
+# application/vnd.etsi.iptvdiscovery+xml
+# application/vnd.etsi.iptvprofile+xml
+# application/vnd.etsi.iptvsad-bc+xml
+# application/vnd.etsi.iptvsad-cod+xml
+# application/vnd.etsi.iptvsad-npvr+xml
+# application/vnd.etsi.iptvservice+xml
+# application/vnd.etsi.iptvsync+xml
+# application/vnd.etsi.iptvueprofile+xml
+# application/vnd.etsi.mcid+xml
+# application/vnd.etsi.overload-control-policy-dataset+xml
+# application/vnd.etsi.sci+xml
+# application/vnd.etsi.simservs+xml
+# application/vnd.etsi.tsl+xml
+# application/vnd.etsi.tsl.der
+# application/vnd.eudora.data
+application/vnd.ezpix-album ez2
+application/vnd.ezpix-package ez3
+# application/vnd.f-secure.mobile
+application/vnd.fdf fdf
+application/vnd.fdsn.mseed mseed
+application/vnd.fdsn.seed seed dataless
+# application/vnd.ffsns
+# application/vnd.fints
+application/vnd.flographit gph
+application/vnd.fluxtime.clip ftc
+# application/vnd.font-fontforge-sfd
+application/vnd.framemaker fm frame maker book
+application/vnd.frogans.fnc fnc
+application/vnd.frogans.ltf ltf
+application/vnd.fsc.weblaunch fsc
+application/vnd.fujitsu.oasys oas
+application/vnd.fujitsu.oasys2 oa2
+application/vnd.fujitsu.oasys3 oa3
+application/vnd.fujitsu.oasysgp fg5
+application/vnd.fujitsu.oasysprs bh2
+# application/vnd.fujixerox.art-ex
+# application/vnd.fujixerox.art4
+# application/vnd.fujixerox.hbpl
+application/vnd.fujixerox.ddd ddd
+application/vnd.fujixerox.docuworks xdw
+application/vnd.fujixerox.docuworks.binder xbd
+# application/vnd.fut-misnet
+application/vnd.fuzzysheet fzs
+application/vnd.genomatix.tuxedo txd
+# application/vnd.geocube+xml
+application/vnd.geogebra.file ggb
+application/vnd.geogebra.tool ggt
+application/vnd.geometry-explorer gex gre
+application/vnd.geonext gxt
+application/vnd.geoplan g2w
+application/vnd.geospace g3w
+# application/vnd.globalplatform.card-content-mgt
+# application/vnd.globalplatform.card-content-mgt-response
+application/vnd.gmx gmx
+application/vnd.google-earth.kml+xml kml
+application/vnd.google-earth.kmz kmz
+application/vnd.grafeq gqf gqs
+# application/vnd.gridmp
+application/vnd.groove-account gac
+application/vnd.groove-help ghf
+application/vnd.groove-identity-message gim
+application/vnd.groove-injector grv
+application/vnd.groove-tool-message gtm
+application/vnd.groove-tool-template tpl
+application/vnd.groove-vcard vcg
+application/vnd.hal+xml hal
+application/vnd.handheld-entertainment+xml zmm
+application/vnd.hbci hbci
+# application/vnd.hcl-bireports
+application/vnd.hhe.lesson-player les
+application/vnd.hp-hpgl hpgl
+application/vnd.hp-hpid hpid
+application/vnd.hp-hps hps
+application/vnd.hp-jlyt jlt
+application/vnd.hp-pcl pcl
+application/vnd.hp-pclxl pclxl
+# application/vnd.httphone
+application/vnd.hydrostatix.sof-data sfd-hdstx
+application/vnd.hzn-3d-crossword x3d
+# application/vnd.ibm.afplinedata
+# application/vnd.ibm.electronic-media
+application/vnd.ibm.minipay mpy
+application/vnd.ibm.modcap afp listafp list3820
+application/vnd.ibm.rights-management irm
+application/vnd.ibm.secure-container sc
+application/vnd.iccprofile icc icm
+application/vnd.igloader igl
+application/vnd.immervision-ivp ivp
+application/vnd.immervision-ivu ivu
+# application/vnd.informedcontrol.rms+xml
+# application/vnd.informix-visionary
+# application/vnd.infotech.project
+# application/vnd.infotech.project+xml
+application/vnd.insors.igm igm
+application/vnd.intercon.formnet xpw xpx
+application/vnd.intergeo i2g
+# application/vnd.intertrust.digibox
+# application/vnd.intertrust.nncp
+application/vnd.intu.qbo qbo
+application/vnd.intu.qfx qfx
+# application/vnd.iptc.g2.conceptitem+xml
+# application/vnd.iptc.g2.knowledgeitem+xml
+# application/vnd.iptc.g2.newsitem+xml
+# application/vnd.iptc.g2.packageitem+xml
+application/vnd.ipunplugged.rcprofile rcprofile
+application/vnd.irepository.package+xml irp
+application/vnd.is-xpr xpr
+application/vnd.isac.fcs fcs
+application/vnd.jam jam
+# application/vnd.japannet-directory-service
+# application/vnd.japannet-jpnstore-wakeup
+# application/vnd.japannet-payment-wakeup
+# application/vnd.japannet-registration
+# application/vnd.japannet-registration-wakeup
+# application/vnd.japannet-setstore-wakeup
+# application/vnd.japannet-verification
+# application/vnd.japannet-verification-wakeup
+application/vnd.jcp.javame.midlet-rms rms
+application/vnd.jisp jisp
+application/vnd.joost.joda-archive joda
+application/vnd.kahootz ktz ktr
+application/vnd.kde.karbon karbon
+application/vnd.kde.kchart chrt
+application/vnd.kde.kformula kfo
+application/vnd.kde.kivio flw
+application/vnd.kde.kontour kon
+application/vnd.kde.kpresenter kpr kpt
+application/vnd.kde.kspread ksp
+application/vnd.kde.kword kwd kwt
+application/vnd.kenameaapp htke
+application/vnd.kidspiration kia
+application/vnd.kinar kne knp
+application/vnd.koan skp skd skt skm
+application/vnd.kodak-descriptor sse
+application/vnd.las.las+xml lasxml
+# application/vnd.liberty-request+xml
+application/vnd.llamagraphics.life-balance.desktop lbd
+application/vnd.llamagraphics.life-balance.exchange+xml lbe
+application/vnd.lotus-1-2-3 123
+application/vnd.lotus-approach apr
+application/vnd.lotus-freelance pre
+application/vnd.lotus-notes nsf
+application/vnd.lotus-organizer org
+application/vnd.lotus-screencam scm
+application/vnd.lotus-wordpro lwp
+application/vnd.macports.portpkg portpkg
+# application/vnd.marlin.drm.actiontoken+xml
+# application/vnd.marlin.drm.conftoken+xml
+# application/vnd.marlin.drm.license+xml
+# application/vnd.marlin.drm.mdcf
+application/vnd.mcd mcd
+application/vnd.medcalcdata mc1
+application/vnd.mediastation.cdkey cdkey
+# application/vnd.meridian-slingshot
+application/vnd.mfer mwf
+application/vnd.mfmp mfm
+application/vnd.micrografx.flo flo
+application/vnd.micrografx.igx igx
+application/vnd.mif mif
+# application/vnd.minisoft-hp3000-save
+# application/vnd.mitsubishi.misty-guard.trustweb
+application/vnd.mobius.daf daf
+application/vnd.mobius.dis dis
+application/vnd.mobius.mbk mbk
+application/vnd.mobius.mqy mqy
+application/vnd.mobius.msl msl
+application/vnd.mobius.plc plc
+application/vnd.mobius.txf txf
+application/vnd.mophun.application mpn
+application/vnd.mophun.certificate mpc
+# application/vnd.motorola.flexsuite
+# application/vnd.motorola.flexsuite.adsi
+# application/vnd.motorola.flexsuite.fis
+# application/vnd.motorola.flexsuite.gotap
+# application/vnd.motorola.flexsuite.kmr
+# application/vnd.motorola.flexsuite.ttc
+# application/vnd.motorola.flexsuite.wem
+# application/vnd.motorola.iprm
+application/vnd.mozilla.xul+xml xul
+application/vnd.ms-artgalry cil
+# application/vnd.ms-asf
+application/vnd.ms-cab-compressed cab
+application/vnd.ms-excel xls xlm xla xlc xlt xlw
+application/vnd.ms-excel.addin.macroenabled.12 xlam
+application/vnd.ms-excel.sheet.binary.macroenabled.12 xlsb
+application/vnd.ms-excel.sheet.macroenabled.12 xlsm
+application/vnd.ms-excel.template.macroenabled.12 xltm
+application/vnd.ms-fontobject eot
+application/vnd.ms-htmlhelp chm
+application/vnd.ms-ims ims
+application/vnd.ms-lrm lrm
+# application/vnd.ms-office.activex+xml
+application/vnd.ms-officetheme thmx
+application/vnd.ms-pki.seccat cat
+application/vnd.ms-pki.stl stl
+# application/vnd.ms-playready.initiator+xml
+application/vnd.ms-powerpoint ppt pps pot
+application/vnd.ms-powerpoint.addin.macroenabled.12 ppam
+application/vnd.ms-powerpoint.presentation.macroenabled.12 pptm
+application/vnd.ms-powerpoint.slide.macroenabled.12 sldm
+application/vnd.ms-powerpoint.slideshow.macroenabled.12 ppsm
+application/vnd.ms-powerpoint.template.macroenabled.12 potm
+application/vnd.ms-project mpp mpt
+# application/vnd.ms-tnef
+# application/vnd.ms-wmdrm.lic-chlg-req
+# application/vnd.ms-wmdrm.lic-resp
+# application/vnd.ms-wmdrm.meter-chlg-req
+# application/vnd.ms-wmdrm.meter-resp
+application/vnd.ms-word.document.macroenabled.12 docm
+application/vnd.ms-word.template.macroenabled.12 dotm
+application/vnd.ms-works wps wks wcm wdb
+application/vnd.ms-wpl wpl
+application/vnd.ms-xpsdocument xps
+application/vnd.mseq mseq
+# application/vnd.msign
+# application/vnd.multiad.creator
+# application/vnd.multiad.creator.cif
+# application/vnd.music-niff
+application/vnd.musician mus
+application/vnd.muvee.style msty
+# application/vnd.ncd.control
+# application/vnd.ncd.reference
+# application/vnd.nervana
+# application/vnd.netfpx
+application/vnd.neurolanguage.nlu nlu
+application/vnd.noblenet-directory nnd
+application/vnd.noblenet-sealer nns
+application/vnd.noblenet-web nnw
+# application/vnd.nokia.catalogs
+# application/vnd.nokia.conml+wbxml
+# application/vnd.nokia.conml+xml
+# application/vnd.nokia.isds-radio-presets
+# application/vnd.nokia.iptv.config+xml
+# application/vnd.nokia.landmark+wbxml
+# application/vnd.nokia.landmark+xml
+# application/vnd.nokia.landmarkcollection+xml
+# application/vnd.nokia.n-gage.ac+xml
+application/vnd.nokia.n-gage.data ngdat
+application/vnd.nokia.n-gage.symbian.install n-gage
+# application/vnd.nokia.ncd
+# application/vnd.nokia.pcd+wbxml
+# application/vnd.nokia.pcd+xml
+application/vnd.nokia.radio-preset rpst
+application/vnd.nokia.radio-presets rpss
+application/vnd.novadigm.edm edm
+application/vnd.novadigm.edx edx
+application/vnd.novadigm.ext ext
+# application/vnd.ntt-local.file-transfer
+# application/vnd.ntt-local.sip-ta_remote
+# application/vnd.ntt-local.sip-ta_tcp_stream
+application/vnd.oasis.opendocument.chart odc
+application/vnd.oasis.opendocument.chart-template otc
+application/vnd.oasis.opendocument.database odb
+application/vnd.oasis.opendocument.formula odf
+application/vnd.oasis.opendocument.formula-template odft
+application/vnd.oasis.opendocument.graphics odg
+application/vnd.oasis.opendocument.graphics-template otg
+application/vnd.oasis.opendocument.image odi
+application/vnd.oasis.opendocument.image-template oti
+application/vnd.oasis.opendocument.presentation odp
+application/vnd.oasis.opendocument.presentation-template otp
+application/vnd.oasis.opendocument.spreadsheet ods
+application/vnd.oasis.opendocument.spreadsheet-template ots
+application/vnd.oasis.opendocument.text odt
+application/vnd.oasis.opendocument.text-master odm
+application/vnd.oasis.opendocument.text-template ott
+application/vnd.oasis.opendocument.text-web oth
+# application/vnd.obn
+# application/vnd.oipf.contentaccessdownload+xml
+# application/vnd.oipf.contentaccessstreaming+xml
+# application/vnd.oipf.cspg-hexbinary
+# application/vnd.oipf.dae.svg+xml
+# application/vnd.oipf.dae.xhtml+xml
+# application/vnd.oipf.mippvcontrolmessage+xml
+# application/vnd.oipf.pae.gem
+# application/vnd.oipf.spdiscovery+xml
+# application/vnd.oipf.spdlist+xml
+# application/vnd.oipf.ueprofile+xml
+# application/vnd.oipf.userprofile+xml
+application/vnd.olpc-sugar xo
+# application/vnd.oma-scws-config
+# application/vnd.oma-scws-http-request
+# application/vnd.oma-scws-http-response
+# application/vnd.oma.bcast.associated-procedure-parameter+xml
+# application/vnd.oma.bcast.drm-trigger+xml
+# application/vnd.oma.bcast.imd+xml
+# application/vnd.oma.bcast.ltkm
+# application/vnd.oma.bcast.notification+xml
+# application/vnd.oma.bcast.provisioningtrigger
+# application/vnd.oma.bcast.sgboot
+# application/vnd.oma.bcast.sgdd+xml
+# application/vnd.oma.bcast.sgdu
+# application/vnd.oma.bcast.simple-symbol-container
+# application/vnd.oma.bcast.smartcard-trigger+xml
+# application/vnd.oma.bcast.sprov+xml
+# application/vnd.oma.bcast.stkm
+# application/vnd.oma.cab-address-book+xml
+# application/vnd.oma.cab-pcc+xml
+# application/vnd.oma.dcd
+# application/vnd.oma.dcdc
+application/vnd.oma.dd2+xml dd2
+# application/vnd.oma.drm.risd+xml
+# application/vnd.oma.group-usage-list+xml
+# application/vnd.oma.poc.detailed-progress-report+xml
+# application/vnd.oma.poc.final-report+xml
+# application/vnd.oma.poc.groups+xml
+# application/vnd.oma.poc.invocation-descriptor+xml
+# application/vnd.oma.poc.optimized-progress-report+xml
+# application/vnd.oma.push
+# application/vnd.oma.scidm.messages+xml
+# application/vnd.oma.xcap-directory+xml
+# application/vnd.omads-email+xml
+# application/vnd.omads-file+xml
+# application/vnd.omads-folder+xml
+# application/vnd.omaloc-supl-init
+application/vnd.openofficeorg.extension oxt
+# application/vnd.openxmlformats-officedocument.custom-properties+xml
+# application/vnd.openxmlformats-officedocument.customxmlproperties+xml
+# application/vnd.openxmlformats-officedocument.drawing+xml
+# application/vnd.openxmlformats-officedocument.drawingml.chart+xml
+# application/vnd.openxmlformats-officedocument.drawingml.chartshapes+xml
+# application/vnd.openxmlformats-officedocument.drawingml.diagramcolors+xml
+# application/vnd.openxmlformats-officedocument.drawingml.diagramdata+xml
+# application/vnd.openxmlformats-officedocument.drawingml.diagramlayout+xml
+# application/vnd.openxmlformats-officedocument.drawingml.diagramstyle+xml
+# application/vnd.openxmlformats-officedocument.extended-properties+xml
+# application/vnd.openxmlformats-officedocument.presentationml.commentauthors+xml
+# application/vnd.openxmlformats-officedocument.presentationml.comments+xml
+# application/vnd.openxmlformats-officedocument.presentationml.handoutmaster+xml
+# application/vnd.openxmlformats-officedocument.presentationml.notesmaster+xml
+# application/vnd.openxmlformats-officedocument.presentationml.notesslide+xml
+application/vnd.openxmlformats-officedocument.presentationml.presentation pptx
+# application/vnd.openxmlformats-officedocument.presentationml.presentation.main+xml
+# application/vnd.openxmlformats-officedocument.presentationml.presprops+xml
+application/vnd.openxmlformats-officedocument.presentationml.slide sldx
+# application/vnd.openxmlformats-officedocument.presentationml.slide+xml
+# application/vnd.openxmlformats-officedocument.presentationml.slidelayout+xml
+# application/vnd.openxmlformats-officedocument.presentationml.slidemaster+xml
+application/vnd.openxmlformats-officedocument.presentationml.slideshow ppsx
+# application/vnd.openxmlformats-officedocument.presentationml.slideshow.main+xml
+# application/vnd.openxmlformats-officedocument.presentationml.slideupdateinfo+xml
+# application/vnd.openxmlformats-officedocument.presentationml.tablestyles+xml
+# application/vnd.openxmlformats-officedocument.presentationml.tags+xml
+application/vnd.openxmlformats-officedocument.presentationml.template potx
+# application/vnd.openxmlformats-officedocument.presentationml.template.main+xml
+# application/vnd.openxmlformats-officedocument.presentationml.viewprops+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.calcchain+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.chartsheet+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.comments+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.connections+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.dialogsheet+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.externallink+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.pivotcachedefinition+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.pivotcacherecords+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.pivottable+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.querytable+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.revisionheaders+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.revisionlog+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.sharedstrings+xml
+application/vnd.openxmlformats-officedocument.spreadsheetml.sheet xlsx
+# application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.sheetmetadata+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.table+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.tablesinglecells+xml
+application/vnd.openxmlformats-officedocument.spreadsheetml.template xltx
+# application/vnd.openxmlformats-officedocument.spreadsheetml.template.main+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.usernames+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.volatiledependencies+xml
+# application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml
+# application/vnd.openxmlformats-officedocument.theme+xml
+# application/vnd.openxmlformats-officedocument.themeoverride+xml
+# application/vnd.openxmlformats-officedocument.vmldrawing
+# application/vnd.openxmlformats-officedocument.wordprocessingml.comments+xml
+application/vnd.openxmlformats-officedocument.wordprocessingml.document docx
+# application/vnd.openxmlformats-officedocument.wordprocessingml.document.glossary+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.document.main+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.endnotes+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.fonttable+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.footer+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.footnotes+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.numbering+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.settings+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.styles+xml
+application/vnd.openxmlformats-officedocument.wordprocessingml.template dotx
+# application/vnd.openxmlformats-officedocument.wordprocessingml.template.main+xml
+# application/vnd.openxmlformats-officedocument.wordprocessingml.websettings+xml
+# application/vnd.openxmlformats-package.core-properties+xml
+# application/vnd.openxmlformats-package.digital-signature-xmlsignature+xml
+# application/vnd.openxmlformats-package.relationships+xml
+# application/vnd.quobject-quoxdocument
+# application/vnd.osa.netdeploy
+application/vnd.osgeo.mapguide.package mgp
+# application/vnd.osgi.bundle
+application/vnd.osgi.dp dp
+# application/vnd.otps.ct-kip+xml
+application/vnd.palm pdb pqa oprc
+# application/vnd.paos.xml
+application/vnd.pawaafile paw
+application/vnd.pg.format str
+application/vnd.pg.osasli ei6
+# application/vnd.piaccess.application-licence
+application/vnd.picsel efif
+application/vnd.pmi.widget wg
+# application/vnd.poc.group-advertisement+xml
+application/vnd.pocketlearn plf
+application/vnd.powerbuilder6 pbd
+# application/vnd.powerbuilder6-s
+# application/vnd.powerbuilder7
+# application/vnd.powerbuilder7-s
+# application/vnd.powerbuilder75
+# application/vnd.powerbuilder75-s
+# application/vnd.preminet
+application/vnd.previewsystems.box box
+application/vnd.proteus.magazine mgz
+application/vnd.publishare-delta-tree qps
+application/vnd.pvi.ptid1 ptid
+# application/vnd.pwg-multiplexed
+# application/vnd.pwg-xhtml-print+xml
+# application/vnd.qualcomm.brew-app-res
+application/vnd.quark.quarkxpress qxd qxt qwd qwt qxl qxb
+# application/vnd.radisys.moml+xml
+# application/vnd.radisys.msml+xml
+# application/vnd.radisys.msml-audit+xml
+# application/vnd.radisys.msml-audit-conf+xml
+# application/vnd.radisys.msml-audit-conn+xml
+# application/vnd.radisys.msml-audit-dialog+xml
+# application/vnd.radisys.msml-audit-stream+xml
+# application/vnd.radisys.msml-conf+xml
+# application/vnd.radisys.msml-dialog+xml
+# application/vnd.radisys.msml-dialog-base+xml
+# application/vnd.radisys.msml-dialog-fax-detect+xml
+# application/vnd.radisys.msml-dialog-fax-sendrecv+xml
+# application/vnd.radisys.msml-dialog-group+xml
+# application/vnd.radisys.msml-dialog-speech+xml
+# application/vnd.radisys.msml-dialog-transform+xml
+# application/vnd.rainstor.data
+# application/vnd.rapid
+application/vnd.realvnc.bed bed
+application/vnd.recordare.musicxml mxl
+application/vnd.recordare.musicxml+xml musicxml
+# application/vnd.renlearn.rlprint
+application/vnd.rig.cryptonote cryptonote
+application/vnd.rim.cod cod
+application/vnd.rn-realmedia rm
+application/vnd.route66.link66+xml link66
+# application/vnd.ruckus.download
+# application/vnd.s3sms
+application/vnd.sailingtracker.track st
+# application/vnd.sbm.cid
+# application/vnd.sbm.mid2
+# application/vnd.scribus
+# application/vnd.sealed.3df
+# application/vnd.sealed.csf
+# application/vnd.sealed.doc
+# application/vnd.sealed.eml
+# application/vnd.sealed.mht
+# application/vnd.sealed.net
+# application/vnd.sealed.ppt
+# application/vnd.sealed.tiff
+# application/vnd.sealed.xls
+# application/vnd.sealedmedia.softseal.html
+# application/vnd.sealedmedia.softseal.pdf
+application/vnd.seemail see
+application/vnd.sema sema
+application/vnd.semd semd
+application/vnd.semf semf
+application/vnd.shana.informed.formdata ifm
+application/vnd.shana.informed.formtemplate itp
+application/vnd.shana.informed.interchange iif
+application/vnd.shana.informed.package ipk
+application/vnd.simtech-mindmapper twd twds
+application/vnd.smaf mmf
+# application/vnd.smart.notebook
+application/vnd.smart.teacher teacher
+# application/vnd.software602.filler.form+xml
+# application/vnd.software602.filler.form-xml-zip
+application/vnd.solent.sdkm+xml sdkm sdkd
+application/vnd.spotfire.dxp dxp
+application/vnd.spotfire.sfs sfs
+# application/vnd.sss-cod
+# application/vnd.sss-dtf
+# application/vnd.sss-ntf
+application/vnd.stardivision.calc sdc
+application/vnd.stardivision.draw sda
+application/vnd.stardivision.impress sdd
+application/vnd.stardivision.math smf
+application/vnd.stardivision.writer sdw vor
+application/vnd.stardivision.writer-global sgl
+application/vnd.stepmania.stepchart sm
+# application/vnd.street-stream
+application/vnd.sun.xml.calc sxc
+application/vnd.sun.xml.calc.template stc
+application/vnd.sun.xml.draw sxd
+application/vnd.sun.xml.draw.template std
+application/vnd.sun.xml.impress sxi
+application/vnd.sun.xml.impress.template sti
+application/vnd.sun.xml.math sxm
+application/vnd.sun.xml.writer sxw
+application/vnd.sun.xml.writer.global sxg
+application/vnd.sun.xml.writer.template stw
+# application/vnd.sun.wadl+xml
+application/vnd.sus-calendar sus susp
+application/vnd.svd svd
+# application/vnd.swiftview-ics
+application/vnd.symbian.install sis sisx
+application/vnd.syncml+xml xsm
+application/vnd.syncml.dm+wbxml bdm
+application/vnd.syncml.dm+xml xdm
+# application/vnd.syncml.dm.notification
+# application/vnd.syncml.ds.notification
+application/vnd.tao.intent-module-archive tao
+application/vnd.tmobile-livetv tmo
+application/vnd.trid.tpt tpt
+application/vnd.triscape.mxs mxs
+application/vnd.trueapp tra
+# application/vnd.truedoc
+# application/vnd.ubisoft.webplayer
+application/vnd.ufdl ufd ufdl
+application/vnd.uiq.theme utz
+application/vnd.umajin umj
+application/vnd.unity unityweb
+application/vnd.uoml+xml uoml
+# application/vnd.uplanet.alert
+# application/vnd.uplanet.alert-wbxml
+# application/vnd.uplanet.bearer-choice
+# application/vnd.uplanet.bearer-choice-wbxml
+# application/vnd.uplanet.cacheop
+# application/vnd.uplanet.cacheop-wbxml
+# application/vnd.uplanet.channel
+# application/vnd.uplanet.channel-wbxml
+# application/vnd.uplanet.list
+# application/vnd.uplanet.list-wbxml
+# application/vnd.uplanet.listcmd
+# application/vnd.uplanet.listcmd-wbxml
+# application/vnd.uplanet.signal
+application/vnd.vcx vcx
+# application/vnd.vd-study
+# application/vnd.vectorworks
+# application/vnd.verimatrix.vcas
+# application/vnd.vidsoft.vidconference
+application/vnd.visio vsd vst vss vsw
+application/vnd.visionary vis
+# application/vnd.vividence.scriptfile
+application/vnd.vsf vsf
+# application/vnd.wap.sic
+# application/vnd.wap.slc
+application/vnd.wap.wbxml wbxml
+application/vnd.wap.wmlc wmlc
+application/vnd.wap.wmlscriptc wmlsc
+application/vnd.webturbo wtb
+# application/vnd.wfa.wsc
+# application/vnd.wmc
+# application/vnd.wmf.bootstrap
+# application/vnd.wolfram.mathematica
+# application/vnd.wolfram.mathematica.package
+application/vnd.wolfram.player nbp
+application/vnd.wordperfect wpd
+application/vnd.wqd wqd
+# application/vnd.wrq-hp3000-labelled
+application/vnd.wt.stf stf
+# application/vnd.wv.csp+wbxml
+# application/vnd.wv.csp+xml
+# application/vnd.wv.ssp+xml
+application/vnd.xara xar
+application/vnd.xfdl xfdl
+# application/vnd.xfdl.webform
+# application/vnd.xmi+xml
+# application/vnd.xmpie.cpkg
+# application/vnd.xmpie.dpkg
+# application/vnd.xmpie.plan
+# application/vnd.xmpie.ppkg
+# application/vnd.xmpie.xlim
+application/vnd.yamaha.hv-dic hvd
+application/vnd.yamaha.hv-script hvs
+application/vnd.yamaha.hv-voice hvp
+application/vnd.yamaha.openscoreformat osf
+application/vnd.yamaha.openscoreformat.osfpvg+xml osfpvg
+# application/vnd.yamaha.remote-setup
+application/vnd.yamaha.smaf-audio saf
+application/vnd.yamaha.smaf-phrase spf
+# application/vnd.yamaha.tunnel-udpencap
+application/vnd.yellowriver-custom-menu cmp
+application/vnd.zul zir zirz
+application/vnd.zzazz.deck+xml zaz
+application/voicexml+xml vxml
+# application/vq-rtcpxr
+# application/watcherinfo+xml
+# application/whoispp-query
+# application/whoispp-response
+application/widget wgt
+application/winhlp hlp
+# application/wita
+# application/wordperfect5.1
+application/wsdl+xml wsdl
+application/wspolicy+xml wspolicy
+application/x-7z-compressed 7z
+application/x-abiword abw
+application/x-ace-compressed ace
+application/x-authorware-bin aab x32 u32 vox
+application/x-authorware-map aam
+application/x-authorware-seg aas
+application/x-bcpio bcpio
+application/x-bittorrent torrent
+application/x-bzip bz
+application/x-bzip2 bz2 boz
+application/x-cdlink vcd
+application/x-chat chat
+application/x-chess-pgn pgn
+# application/x-compress
+application/x-cpio cpio
+application/x-csh csh
+application/x-debian-package deb udeb
+application/x-director dir dcr dxr cst cct cxt w3d fgd swa
+application/x-doom wad
+application/x-dtbncx+xml ncx
+application/x-dtbook+xml dtb
+application/x-dtbresource+xml res
+application/x-dvi dvi
+application/x-font-bdf bdf
+# application/x-font-dos
+# application/x-font-framemaker
+application/x-font-ghostscript gsf
+# application/x-font-libgrx
+application/x-font-linux-psf psf
+application/x-font-otf otf
+application/x-font-pcf pcf
+application/x-font-snf snf
+# application/x-font-speedo
+# application/x-font-sunos-news
+application/x-font-ttf ttf ttc
+application/x-font-type1 pfa pfb pfm afm
+application/x-font-woff woff
+# application/x-font-vfont
+application/x-futuresplash spl
+application/x-gnumeric gnumeric
+application/x-gtar gtar
+# application/x-gzip
+application/x-hdf hdf
+application/x-java-jnlp-file jnlp
+application/x-latex latex
+application/x-mobipocket-ebook prc mobi
+application/x-ms-application application
+application/x-ms-wmd wmd
+application/x-ms-wmz wmz
+application/x-ms-xbap xbap
+application/x-msaccess mdb
+application/x-msbinder obd
+application/x-mscardfile crd
+application/x-msclip clp
+application/x-msdownload exe dll com bat msi
+application/x-msmediaview mvb m13 m14
+application/x-msmetafile wmf
+application/x-msmoney mny
+application/x-mspublisher pub
+application/x-msschedule scd
+application/x-msterminal trm
+application/x-mswrite wri
+application/x-netcdf nc cdf
+application/x-pkcs12 p12 pfx
+application/x-pkcs7-certificates p7b spc
+application/x-pkcs7-certreqresp p7r
+application/x-rar-compressed rar
+application/x-sh sh
+application/x-shar shar
+application/x-shockwave-flash swf
+application/x-silverlight-app xap
+application/x-stuffit sit
+application/x-stuffitx sitx
+application/x-sv4cpio sv4cpio
+application/x-sv4crc sv4crc
+application/x-tar tar
+application/x-tcl tcl
+application/x-tex tex
+application/x-tex-tfm tfm
+application/x-texinfo texinfo texi
+application/x-ustar ustar
+application/x-wais-source src
+application/x-x509-ca-cert der crt
+application/x-xfig fig
+application/x-xpinstall xpi
+# application/x400-bp
+# application/xcap-att+xml
+# application/xcap-caps+xml
+application/xcap-diff+xml xdf
+# application/xcap-el+xml
+# application/xcap-error+xml
+# application/xcap-ns+xml
+# application/xcon-conference-info-diff+xml
+# application/xcon-conference-info+xml
+application/xenc+xml xenc
+application/xhtml+xml xhtml xht
+# application/xhtml-voice+xml
+application/xml xml xsl
+application/xml-dtd dtd
+# application/xml-external-parsed-entity
+# application/xmpp+xml
+application/xop+xml xop
+application/xslt+xml xslt
+application/xspf+xml xspf
+application/xv+xml mxml xhvml xvml xvm
+application/yang yang
+application/yin+xml yin
+application/zip zip
+# audio/1d-interleaved-parityfec
+# audio/32kadpcm
+# audio/3gpp
+# audio/3gpp2
+# audio/ac3
+audio/adpcm adp
+# audio/amr
+# audio/amr-wb
+# audio/amr-wb+
+# audio/asc
+# audio/atrac-advanced-lossless
+# audio/atrac-x
+# audio/atrac3
+audio/basic au snd
+# audio/bv16
+# audio/bv32
+# audio/clearmode
+# audio/cn
+# audio/dat12
+# audio/dls
+# audio/dsr-es201108
+# audio/dsr-es202050
+# audio/dsr-es202211
+# audio/dsr-es202212
+# audio/dvi4
+# audio/eac3
+# audio/evrc
+# audio/evrc-qcp
+# audio/evrc0
+# audio/evrc1
+# audio/evrcb
+# audio/evrcb0
+# audio/evrcb1
+# audio/evrcwb
+# audio/evrcwb0
+# audio/evrcwb1
+# audio/example
+# audio/g719
+# audio/g722
+# audio/g7221
+# audio/g723
+# audio/g726-16
+# audio/g726-24
+# audio/g726-32
+# audio/g726-40
+# audio/g728
+# audio/g729
+# audio/g7291
+# audio/g729d
+# audio/g729e
+# audio/gsm
+# audio/gsm-efr
+# audio/gsm-hr-08
+# audio/ilbc
+# audio/l16
+# audio/l20
+# audio/l24
+# audio/l8
+# audio/lpc
+audio/midi mid midi kar rmi
+# audio/mobile-xmf
+audio/mp4 mp4a
+# audio/mp4a-latm
+# audio/mpa
+# audio/mpa-robust
+audio/mpeg mpga mp2 mp2a mp3 m2a m3a
+# audio/mpeg4-generic
+audio/ogg oga ogg spx
+# audio/parityfec
+# audio/pcma
+# audio/pcma-wb
+# audio/pcmu-wb
+# audio/pcmu
+# audio/prs.sid
+# audio/qcelp
+# audio/red
+# audio/rtp-enc-aescm128
+# audio/rtp-midi
+# audio/rtx
+# audio/smv
+# audio/smv0
+# audio/smv-qcp
+# audio/sp-midi
+# audio/speex
+# audio/t140c
+# audio/t38
+# audio/telephone-event
+# audio/tone
+# audio/uemclip
+# audio/ulpfec
+# audio/vdvi
+# audio/vmr-wb
+# audio/vnd.3gpp.iufp
+# audio/vnd.4sb
+# audio/vnd.audiokoz
+# audio/vnd.celp
+# audio/vnd.cisco.nse
+# audio/vnd.cmles.radio-events
+# audio/vnd.cns.anp1
+# audio/vnd.cns.inf1
+audio/vnd.dece.audio uva uvva
+audio/vnd.digital-winds eol
+# audio/vnd.dlna.adts
+# audio/vnd.dolby.heaac.1
+# audio/vnd.dolby.heaac.2
+# audio/vnd.dolby.mlp
+# audio/vnd.dolby.mps
+# audio/vnd.dolby.pl2
+# audio/vnd.dolby.pl2x
+# audio/vnd.dolby.pl2z
+# audio/vnd.dolby.pulse.1
+audio/vnd.dra dra
+audio/vnd.dts dts
+audio/vnd.dts.hd dtshd
+# audio/vnd.everad.plj
+# audio/vnd.hns.audio
+audio/vnd.lucent.voice lvp
+audio/vnd.ms-playready.media.pya pya
+# audio/vnd.nokia.mobile-xmf
+# audio/vnd.nortel.vbk
+audio/vnd.nuera.ecelp4800 ecelp4800
+audio/vnd.nuera.ecelp7470 ecelp7470
+audio/vnd.nuera.ecelp9600 ecelp9600
+# audio/vnd.octel.sbc
+# audio/vnd.qcelp
+# audio/vnd.rhetorex.32kadpcm
+audio/vnd.rip rip
+# audio/vnd.sealedmedia.softseal.mpeg
+# audio/vnd.vmx.cvsd
+# audio/vorbis
+# audio/vorbis-config
+audio/webm weba
+audio/x-aac aac
+audio/x-aiff aif aiff aifc
+audio/x-mpegurl m3u
+audio/x-ms-wax wax
+audio/x-ms-wma wma
+audio/x-pn-realaudio ram ra
+audio/x-pn-realaudio-plugin rmp
+audio/x-wav wav
+chemical/x-cdx cdx
+chemical/x-cif cif
+chemical/x-cmdf cmdf
+chemical/x-cml cml
+chemical/x-csml csml
+# chemical/x-pdb
+chemical/x-xyz xyz
+image/bmp bmp
+image/cgm cgm
+# image/example
+# image/fits
+image/g3fax g3
+image/gif gif
+image/ief ief
+# image/jp2
+image/jpeg jpeg jpg jpe
+# image/jpm
+# image/jpx
+image/ktx ktx
+# image/naplps
+image/png png
+image/prs.btif btif
+# image/prs.pti
+image/svg+xml svg svgz
+# image/t38
+image/tiff tiff tif
+# image/tiff-fx
+image/vnd.adobe.photoshop psd
+# image/vnd.cns.inf2
+image/vnd.dece.graphic uvi uvvi uvg uvvg
+image/vnd.dvb.subtitle sub
+image/vnd.djvu djvu djv
+image/vnd.dwg dwg
+image/vnd.dxf dxf
+image/vnd.fastbidsheet fbs
+image/vnd.fpx fpx
+image/vnd.fst fst
+image/vnd.fujixerox.edmics-mmr mmr
+image/vnd.fujixerox.edmics-rlc rlc
+# image/vnd.globalgraphics.pgb
+# image/vnd.microsoft.icon
+# image/vnd.mix
+image/vnd.ms-modi mdi
+image/vnd.net-fpx npx
+# image/vnd.radiance
+# image/vnd.sealed.png
+# image/vnd.sealedmedia.softseal.gif
+# image/vnd.sealedmedia.softseal.jpg
+# image/vnd.svf
+image/vnd.wap.wbmp wbmp
+image/vnd.xiff xif
+image/webp webp
+image/x-cmu-raster ras
+image/x-cmx cmx
+image/x-freehand fh fhc fh4 fh5 fh7
+image/x-icon ico
+image/x-pcx pcx
+image/x-pict pic pct
+image/x-portable-anymap pnm
+image/x-portable-bitmap pbm
+image/x-portable-graymap pgm
+image/x-portable-pixmap ppm
+image/x-rgb rgb
+image/x-xbitmap xbm
+image/x-xpixmap xpm
+image/x-xwindowdump xwd
+# message/cpim
+# message/delivery-status
+# message/disposition-notification
+# message/example
+# message/external-body
+# message/feedback-report
+# message/global
+# message/global-delivery-status
+# message/global-disposition-notification
+# message/global-headers
+# message/http
+# message/imdn+xml
+# message/news
+# message/partial
+message/rfc822 eml mime
+# message/s-http
+# message/sip
+# message/sipfrag
+# message/tracking-status
+# message/vnd.si.simp
+# model/example
+model/iges igs iges
+model/mesh msh mesh silo
+model/vnd.collada+xml dae
+model/vnd.dwf dwf
+# model/vnd.flatland.3dml
+model/vnd.gdl gdl
+# model/vnd.gs-gdl
+# model/vnd.gs.gdl
+model/vnd.gtw gtw
+# model/vnd.moml+xml
+model/vnd.mts mts
+# model/vnd.parasolid.transmit.binary
+# model/vnd.parasolid.transmit.text
+model/vnd.vtu vtu
+model/vrml wrl vrml
+# multipart/alternative
+# multipart/appledouble
+# multipart/byteranges
+# multipart/digest
+# multipart/encrypted
+# multipart/example
+# multipart/form-data
+# multipart/header-set
+# multipart/mixed
+# multipart/parallel
+# multipart/related
+# multipart/report
+# multipart/signed
+# multipart/voice-message
+# text/1d-interleaved-parityfec
+text/calendar ics ifb
+text/css css
+text/csv csv
+# text/directory
+# text/dns
+# text/ecmascript
+# text/enriched
+# text/example
+text/html html htm
+# text/javascript
+text/n3 n3
+# text/parityfec
+text/plain txt text conf def list log in
+# text/prs.fallenstein.rst
+text/prs.lines.tag dsc
+# text/vnd.radisys.msml-basic-layout
+# text/red
+# text/rfc822-headers
+text/richtext rtx
+# text/rtf
+# text/rtp-enc-aescm128
+# text/rtx
+text/sgml sgml sgm
+# text/t140
+text/tab-separated-values tsv
+text/troff t tr roff man me ms
+text/turtle ttl
+# text/ulpfec
+text/uri-list uri uris urls
+# text/vnd.abc
+text/vnd.curl curl
+text/vnd.curl.dcurl dcurl
+text/vnd.curl.scurl scurl
+text/vnd.curl.mcurl mcurl
+# text/vnd.dmclientscript
+# text/vnd.esmertec.theme-descriptor
+text/vnd.fly fly
+text/vnd.fmi.flexstor flx
+text/vnd.graphviz gv
+text/vnd.in3d.3dml 3dml
+text/vnd.in3d.spot spot
+# text/vnd.iptc.newsml
+# text/vnd.iptc.nitf
+# text/vnd.latex-z
+# text/vnd.motorola.reflex
+# text/vnd.ms-mediapackage
+# text/vnd.net2phone.commcenter.command
+# text/vnd.si.uricatalogue
+text/vnd.sun.j2me.app-descriptor jad
+# text/vnd.trolltech.linguist
+# text/vnd.wap.si
+# text/vnd.wap.sl
+text/vnd.wap.wml wml
+text/vnd.wap.wmlscript wmls
+text/x-asm s asm
+text/x-c c cc cxx cpp h hh dic
+text/x-fortran f for f77 f90
+text/x-pascal p pas
+text/x-java-source java
+text/x-setext etx
+text/x-uuencode uu
+text/x-vcalendar vcs
+text/x-vcard vcf
+# text/xml
+# text/xml-external-parsed-entity
+# video/1d-interleaved-parityfec
+video/3gpp 3gp
+# video/3gpp-tt
+video/3gpp2 3g2
+# video/bmpeg
+# video/bt656
+# video/celb
+# video/dv
+# video/example
+video/h261 h261
+video/h263 h263
+# video/h263-1998
+# video/h263-2000
+video/h264 h264
+# video/h264-rcdo
+# video/h264-svc
+video/jpeg jpgv
+# video/jpeg2000
+video/jpm jpm jpgm
+video/mj2 mj2 mjp2
+# video/mp1s
+# video/mp2p
+# video/mp2t
+video/mp4 mp4 mp4v mpg4
+# video/mp4v-es
+video/mpeg mpeg mpg mpe m1v m2v
+# video/mpeg4-generic
+# video/mpv
+# video/nv
+video/ogg ogv
+# video/parityfec
+# video/pointer
+video/quicktime qt mov
+# video/raw
+# video/rtp-enc-aescm128
+# video/rtx
+# video/smpte292m
+# video/ulpfec
+# video/vc1
+# video/vnd.cctv
+video/vnd.dece.hd uvh uvvh
+video/vnd.dece.mobile uvm uvvm
+# video/vnd.dece.mp4
+video/vnd.dece.pd uvp uvvp
+video/vnd.dece.sd uvs uvvs
+video/vnd.dece.video uvv uvvv
+# video/vnd.directv.mpeg
+# video/vnd.directv.mpeg-tts
+# video/vnd.dlna.mpeg-tts
+video/vnd.fvt fvt
+# video/vnd.hns.video
+# video/vnd.iptvforum.1dparityfec-1010
+# video/vnd.iptvforum.1dparityfec-2005
+# video/vnd.iptvforum.2dparityfec-1010
+# video/vnd.iptvforum.2dparityfec-2005
+# video/vnd.iptvforum.ttsavc
+# video/vnd.iptvforum.ttsmpeg2
+# video/vnd.motorola.video
+# video/vnd.motorola.videop
+video/vnd.mpegurl mxu m4u
+video/vnd.ms-playready.media.pyv pyv
+# video/vnd.nokia.interleaved-multimedia
+# video/vnd.nokia.videovoip
+# video/vnd.objectvideo
+# video/vnd.sealed.mpeg1
+# video/vnd.sealed.mpeg4
+# video/vnd.sealed.swf
+# video/vnd.sealedmedia.softseal.mov
+video/vnd.uvvu.mp4 uvu uvvu
+video/vnd.vivo viv
+video/webm webm
+video/x-f4v f4v
+video/x-fli fli
+video/x-flv flv
+video/x-m4v m4v
+video/x-ms-asf asf asx
+video/x-ms-wm wm
+video/x-ms-wmv wmv
+video/x-ms-wmx wmx
+video/x-ms-wvx wvx
+video/x-msvideo avi
+video/x-sgi-movie movie
+x-conference/x-cooltalk ice
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm
new file mode 100644
index 0000000000..5cb6f5a45c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64.pm
@@ -0,0 +1,589 @@
+package Math::Int64;
+
+use strict;
+use warnings;
+
+BEGIN {
+our $VERSION = '0.54';
+require XSLoader;
+XSLoader::load('Math::Int64', $VERSION);
+}
+
+use warnings::register;
+
+use constant MAX_INT64 => string_to_int64 ( '0x7fff_ffff_ffff_ffff');
+use constant MIN_INT64 => string_to_int64 ('-0x8000_0000_0000_0000');
+use constant MAX_UINT64 => string_to_uint64( '0xffff_ffff_ffff_ffff');
+
+require Exporter;
+our @ISA = qw(Exporter);
+our @EXPORT_OK = qw(int64
+ int64_to_number
+ net_to_int64 int64_to_net
+ native_to_int64 int64_to_native
+ string_to_int64 hex_to_int64
+ BER_to_int64 int64_to_BER
+ int64_to_string int64_to_hex
+ int64_rand
+ int64_srand
+ uint64
+ uint64_to_number
+ net_to_uint64 uint64_to_net
+ native_to_uint64 uint64_to_native
+ string_to_uint64 hex_to_uint64
+ BER_to_uint64 uint64_to_BER
+ uint64_to_string uint64_to_hex
+ uint64_rand
+ BER_length
+ MAX_INT64 MIN_INT64 MAX_UINT64
+ );
+
+my %available_pragmas = map { $_ => 1 } qw(native_if_available
+ die_on_overflow);
+
+sub import {
+ my $pkg = shift;
+ my (%pragmas, @subs, %native);
+ for (@_) {
+ if ($_ =~ /^:(.*)/ and $available_pragmas{$1}) {
+ $pragmas{$1} = 1
+ }
+ else {
+ push @subs, $_;
+ }
+ }
+
+ if ($pragmas{die_on_overflow}) {
+ require Math::Int64::die_on_overflow;
+ Math::Int64::die_on_overflow->import;
+ }
+
+ if ($pragmas{native_if_available}) {
+ require Math::Int64::native_if_available;
+ Math::Int64::native_if_available->import;
+ }
+
+ Math::Int64->export_to_level(1, $pkg, @subs);
+}
+
+sub _check_pragma_compatibility {
+ if ($^H{'Math::Int64::native_if_available'} and
+ $^H{'Math::Int64::die_on_overflow'} and
+ warnings::enabled()) {
+ warnings::warn("Math::Int64::die_on_overflow pragma is useless when Math::Int64::native_if_available is also active");
+ }
+ 1;
+}
+
+use overload ( '+' => \&_add,
+ '+=' => \&_add,
+ '-' => \&_sub,
+ '-=' => \&_sub,
+ '*' => \&_mul,
+ '*=' => \&_mul,
+ '**' => \&_pow,
+ '**=' => \&_pow,
+ '/' => \&_div,
+ '/=' => \&_div,
+ '%' => \&_rest,
+ '%=' => \&_rest,
+ 'neg' => \&_neg,
+ '++' => \&_inc,
+ '--' => \&_dec,
+ '!' => \&_not,
+ '~' => \&_bnot,
+ '&' => \&_and,
+ '|' => \&_or,
+ '^' => \&_xor,
+ '<<' => \&_left,
+ '>>' => \&_right,
+ '<=>' => \&_spaceship,
+ '>' => \&_gtn,
+ '<' => \&_ltn,
+ '>=' => \&_gen,
+ '<=' => \&_len,
+ '==' => \&_eqn,
+ '!=' => \&_nen,
+ 'bool' => \&_bool,
+ '0+' => \&_number,
+ '""' => \&_string,
+ '=' => \&_clone,
+ fallback => 1 );
+
+package # hide from PAUSE since it also has its own .pm file
+ Math::UInt64;
+use overload ( '+' => \&_add,
+ '+=' => \&_add,
+ '-' => \&_sub,
+ '-=' => \&_sub,
+ '*' => \&_mul,
+ '*=' => \&_mul,
+ '**' => \&_pow,
+ '**=' => \&_pow,
+ '/' => \&_div,
+ '/=' => \&_div,
+ '%' => \&_rest,
+ '%=' => \&_rest,
+ 'neg' => \&_neg,
+ '++' => \&_inc,
+ '--' => \&_dec,
+ '!' => \&_not,
+ '~' => \&_bnot,
+ '&' => \&_and,
+ '|' => \&_or,
+ '^' => \&_xor,
+ '<<' => \&_left,
+ '>>' => \&_right,
+ '<=>' => \&_spaceship,
+ '>' => \&_gtn,
+ '<' => \&_ltn,
+ '>=' => \&_gen,
+ '<=' => \&_len,
+ '==' => \&_eqn,
+ '!=' => \&_nen,
+ 'bool' => \&_bool,
+ '0+' => \&_number,
+ '""' => \&_string,
+ '=' => \&_clone,
+ fallback => 1 );
+
+1;
+
+# ABSTRACT: Manipulate 64 bits integers in Perl
+
+__END__
+
+=encoding UTF-8
+
+=head1 NAME
+
+Math::Int64 - Manipulate 64 bits integers in Perl
+
+=head1 SYNOPSIS
+
+ use Math::Int64 qw(int64 uint64);
+
+ my $i = int64(1);
+ my $j = $i << 40;
+ print($i + $j * 1000000);
+
+ my $k = uint64("12345678901234567890");
+
+=head1 DESCRIPTION
+
+This module adds support for 64 bit integers, signed and unsigned, to
+Perl.
+
+=head2 Exportable functions
+
+=over 4
+
+=item int64()
+
+=item int64($value)
+
+Creates a new int64 value and initializes it to C<$value>, where
+$value can be a Perl number or a string containing a number.
+
+For instance:
+
+ $i = int64(34);
+ $j = int64("-123454321234543212345");
+
+ $k = int64(1234567698478483938988988); # wrong!!!
+ # the unquoted number would
+ # be converted first to a
+ # real number causing it to
+ # loose some precision.
+
+Once the int64 number is created it can be manipulated as any other
+Perl value supporting all the standard operations (addition, negation,
+multiplication, postincrement, etc.).
+
+
+=item net_to_int64($str)
+
+Converts an 8 bytes string containing an int64 in network order to the
+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.
+
+=item native_to_int64($str)
+
+=item int64_to_native($int64)
+
+similar to net_to_int64 and int64_to_net, but using the native CPU
+order.
+
+=item int64_to_number($int64)
+
+returns the optimum representation of the int64 value using Perl
+internal types (IV, UV or NV). Precision may be lost.
+
+For instance:
+
+ for my $l (10, 20, 30, 40, 50, 60) {
+ my $i = int64(1) << $l;
+ my $n = int64_to_number($i);
+ print "int64:$i => perl:$n\n";
+ }
+
+=item string_to_int64($str, $base)
+
+Converts the string to a int64 value. The conversion is done according
+to the given base, which must be a number between 2 and 36 inclusive
+or the special value 0. C<$base> defaults to 0.
+
+The string may begin with an arbitrary amount of white space followed
+by a single optional C<+> or C<-> sign. If base is zero or 16, the
+string may then include a "0x" prefix, and the number will be read in
+base 16; otherwise, a zero base is taken as 10 (decimal) unless the
+next character is '0', in which case it is taken as 8 (octal).
+
+Underscore characters (C<_>) between the digits are ignored.
+
+No overflow checks are performed by this function unless the
+C<die_on_overflow> pragma is used (see L</Die on overflow> below).
+
+See also L<strtoll(3)>.
+
+=item hex_to_int64($i64)
+
+Shortcut for string_to_int64($str, 16)
+
+=item int64_to_string($i64, $base)
+
+Converts the int64 value to its string representation in the given
+base (defaults to 10).
+
+=item int64_to_hex($i64)
+
+Shortcut for C<int64_to_string($i64, 16)>.
+
+=item int64_to_BER($i64)
+
+Converts the int64 value to its BER representation (see
+L<perlfunc/pack> for a description of the BER format).
+
+In the case of signed numbers, they are transformed into unsigned
+numbers before encoding them in the BER format with the following
+rule:
+
+ $neg = ($i64 < 0 ? 1 : 0);
+ $u64 = (($neg ? ~$i64 : $i64) << 1) | $neg;
+
+That way, positive and negative integers are interleaved as 0, -1, 1,
+2, -2, .... The format is similar to that used by Google protocol
+buffers to encode signed variants but with the most significant groups
+first (protocol buffers uses the least significant groups first
+variant).
+
+If you don't want that preprocessing for signed numbers, just use the
+C<uint64_to_BER> function instead.
+
+=item BER_to_int64($str)
+
+Decodes the int64 number in BER format from the given string.
+
+There must not be any extra bytes on the string after the encoded number.
+
+=item BER_length($str)
+
+Given a string with a BER encoded number at the beginning, this
+function returns the number of bytes it uses.
+
+The right way to shift a BER encoded number from the beginning of some
+string is as follows:
+
+ $i64 = BER_to_int64(substr($str, 0, BER_length($str), ''));
+
+=item int64_rand
+
+Generates a 64 bit random number using ISAAC-64 algorithm.
+
+=item int64_srand($seed)
+
+=item int64_srand()
+
+Sets the seed for the random number generator.
+
+C<$seed>, if given, should be a 2KB long string.
+
+=item uint64
+
+=item uint64_to_number
+
+=item net_to_uint64
+
+=item uint64_to_net
+
+=item native_to_uint64
+
+=item uint64_to_native
+
+=item string_to_uint64
+
+=item hex_to_uint64
+
+=item uint64_to_string
+
+=item uint64_to_hex
+
+These functions are similar to their int64 counterparts, but
+manipulate 64 bit unsigned integers.
+
+=item uint64_to_BER($u64)
+
+Encodes the given unsigned integer in BER format (see L<perlfunc/pack>).
+
+=item BER_to_uint64($str)
+
+Decodes from the given string an unsigned number in BER format.
+
+=item uint64_rand
+
+Generates a 64 bit random unsigned number using ISAAC-64 algorithm.
+
+=back
+
+=head2 Die on overflow
+
+The lexical pragma C<Math::Int64::die_on_overflow> configures the
+module to throw an error when some operation results in integer
+overflow.
+
+For instance:
+
+ use Math::Int64 qw(uint64);
+ use Math::Int64::die_on_overflow;
+
+ my $zero = uint64(0);
+ say ($zero - 1); # dies as -1 falls outside
+ # the uint64_t range
+
+ no Math::Int64::die_on_overflow; # deactivates lexical pragma
+ say ($zero - 1); # no error is detected here!
+
+The pragma can also be activated as follows:
+
+ use Math::Int64 ':die_on_overflow';
+
+Once this pragma is used, several Math::Int64 operations may become
+slower. Deactivating the pragma will not make them fast again.
+
+On Perl 5.8.x, as lexical pragmas support is not available, the pragma
+C<die_on_overflow> pragma is global and can not be deactivated.
+
+=head2 Fallback to native 64bit support if available
+
+If the lexical pragma C<Math::Int64::native_if_available> is used in
+your program and the version of perl in use has native support for
+64bit integers, the functions imported from the module that create
+64bit integers (i.e. C<uint64>, C<int64>, C<string_to_int64>,
+C<native_to_int64>, etc.) will return regular perl scalars.
+
+For instance:
+
+ use Math::Int64 qw(int64);
+
+ $a = int64(34); # always returns an object of the class Math::Int64
+
+ use Math::Int64::native_if_available;
+ $a = int64(34); # returns a regular scalar on perls compiled with
+ # 64bit support
+
+This feature is not enabled by default because the semantics for perl
+scalars and for 64 bit integers as implemented in this module are not
+identical.
+
+Perl is prone to coerce integers into floats while this module keeps
+then always as 64bit integers. Specifically, the division operation
+and overflows are the most problematic cases. Also, when using native
+integers, the signed/unsigned division blurs.
+
+Besides that, in most situations it is safe to use the native fallback.
+
+As happens with the C<die_on_overflow> pragma, on Perl 5.8.x it is
+global.
+
+The pragma can also be activated as follows:
+
+ use Math::Int64 ':native_if_available';
+
+=head2 Transparent conversion of objects to int64/uint64
+
+When in some operation involving int64/uint64 numbers, a blessed
+object is passed as an operand, the module would try to coerce the
+object into an int64/uint64 number calling the methods
+C<as_int64>/C<as_uint64> respectively.
+
+If the corresponding method is not implemented, the object will be
+stringified and then parsed as a base 10 number.
+
+=head2 Storable integration
+
+Objects of classes Math::Int64 and Math::UInt64 implement the
+STORABLE_freeze and STORABLE_thaw methods for a transparent
+integration with L<Storable>.
+
+=head2 C API
+
+This module provides a native C API that can be used to create and
+read Math::Int64 int64 and uint64 SVs from your own XS modules.
+
+In order to use it you need to follow these steps:
+
+=over 4
+
+=item *
+
+Import the files C<perl_math_int64.c>, C<perl_math_int64.h> and
+optionally C<typemaps> from Math::Int64 C<c_api_client> directory into
+your project directory.
+
+=item *
+
+Include the file C<perl_math_int64.h> in the C or XS source files
+where you want to convert 64bit integers to/from Perl SVs.
+
+Note that this header file requires the types int64_t and uint64_t to
+be defined beforehand.
+
+=item *
+
+Add the file C<perl_math_int64.c> to your compilation targets (see the
+sample Makefile.PL below).
+
+=item *
+
+Add a call to the macro C<PERL_MATH_INT64_LOAD_OR_CROAK> into the
+C<BOOT> section of your XS file.
+
+=back
+
+For instance:
+
+ --- Foo64.xs ---------
+
+ #include "EXTERN.h"
+ #include "perl.h"
+ #include "XSUB.h"
+ #include "ppport.h"
+
+ /* #define MATH_INT64_NATIVE_IF_AVAILABLE */
+ #include "math_int64.h"
+
+ MODULE = Foo64 PACKAGE = Foo64
+ BOOT:
+ PERL_MATH_INT64_LOAD_OR_CROAK;
+
+ int64_t
+ some_int64()
+ CODE:
+ RETVAL = -42;
+ OUTPUT:
+ RETVAL
+
+
+ --- Makefile.PL -----
+
+ use ExtUtils::MakeMaker;
+ WriteMakefile( NAME => 'Foo64',
+ VERSION_FROM => 'lib/Foo64.pm',
+ OBJECT => '$(O_FILES)' );
+
+
+If the macro C<MATH_INT64_NATIVE_IF_AVAILABLE> is defined before
+including C<perl_math_int64.h> and the perl interpreter is compiled
+with native 64bit integer support, IVs will be used to represent 64bit
+integers instead of the object representation provided by Math::Int64.
+
+These are the C macros available from Math::Int64 C API:
+
+=over 4
+
+=item SV *newSVi64(int64_t i64)
+
+Returns an SV representing the given int64_t value.
+
+=item SV *newSVu64(uint64_t 64)
+
+Returns an SV representing the given uint64_t value.
+
+=item int64_t SvI64(SV *sv)
+
+Extracts the int64_t value from the given SV.
+
+=item uint64_t SvU64(SV *sv)
+
+Extracts the uint64_t value from the given SV.
+
+=item int SvI64OK(SV *sv)
+
+Returns true is the given SV contains a valid int64_t value.
+
+=item int SvU64OK(SV *sv)
+
+Returns true is the given SV contains a valid uint64_t value.
+
+=item uint64_t randU64(void)
+
+Returns a random 64 bits unsigned integer.
+
+=item SV sv_seti64(SV *sv, uint64_t i64)
+
+Sets the value of the perl scalar to the given int64_t value.
+
+=item SV sv_setu64(SV *sv, uint64_t i64)
+
+Sets the value of the perl scalar to the given uint64_t value.
+
+=back
+
+If you require any other function available through the C API don't
+hesitate to ask for it!
+
+=head1 BUGS AND SUPPORT
+
+The Storable integration feature is experimental.
+
+The C API feature is experimental.
+
+This module requires int64 support from the C compiler.
+
+In order to report bugs you can send me and email to the address that
+appears below or use the CPAN RT bug tracking system available at
+L<http://rt.cpan.org>.
+
+The source for the development version of the module is hosted at
+GitHub: L<https://github.com/salva/p5-Math-Int64>.
+
+=head2 My wishlist
+
+If you like this module and you're feeling generous, take a look at my
+Amazon Wish List: L<http://amzn.com/w/1WU1P6IR5QZ42>
+
+=head1 SEE ALSO
+
+The C API usage sample module L<Math::Int64::C_API::Sample>.
+
+Other modules providing support for larger integers or numbers are
+L<Math::BigInt>, L<Math::BigRat> and L<Math::Big>,
+L<Math::BigInt::BitVect>, L<Math::BigInt::Pari> and
+L<Math::BigInt::GMP>.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright E<copy> 2007, 2009, 2011-2015 by Salvador Fandiño
+(sfandino@yahoo.com)
+
+Copyright E<copy> 2014-2015 by Dave Rolsky (autarch@urth.org)
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.8.8 or,
+at your option, any later version of Perl 5 you may have available.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64/die_on_overflow.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64/die_on_overflow.pm
new file mode 100644
index 0000000000..5212cc9384
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64/die_on_overflow.pm
@@ -0,0 +1,45 @@
+package Math::Int64::die_on_overflow;
+
+use strict;
+use warnings;
+
+use Math::Int64 ();
+
+sub import {
+ require Math::Int64;
+ Math::Int64::_set_may_die_on_overflow(1);
+ $^H{'Math::Int64::die_on_overflow'} = 1;
+ goto &Math::Int64::_check_pragma_compatibility;
+}
+
+
+sub unimport {
+ undef $^H{'Math::Int64::die_on_overflow'}
+}
+
+1;
+
+# ABSTRACT: catch overflows when using Math::Int64
+
+__END__
+
+=encoding UTF-8
+
+=head1 NAME
+
+Math::Int64::die_on_overflow - catch overflows when using Math::Int64
+
+=head1 SYNOPSIS
+
+ use Math::Int64 qw(uint64);
+ use Math::Int64::die_on_overflow;
+
+ my $number = uint64(2**32);
+ say($number * $number); # overflow error!
+
+
+=head1 SEE ALSO
+
+L<Math::Int64>.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64/native_if_available.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64/native_if_available.pm
new file mode 100644
index 0000000000..34776b92c1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/Int64/native_if_available.pm
@@ -0,0 +1,43 @@
+package Math::Int64::native_if_available;
+
+use strict;
+use warnings;
+
+use Math::Int64 ();
+
+sub import {
+ if (Math::Int64::_backend() eq 'IV' and $] >= 5.008) {
+ Math::Int64::_set_may_use_native(1);
+ $^H{'Math::Int64::native_if_available'} = 1;
+ goto &Math::Int64::_check_pragma_compatibility;
+ }
+}
+
+sub unimport {
+ undef $^H{'Math::Int64::native_if_available'};
+}
+
+1;
+
+# ABSTRACT: Use the native Perl 64-bit integer implementation when available
+
+__END__
+
+=encoding UTF-8
+
+=head1 NAME
+
+Math::Int64::native_if_available - Use the native Perl 64-bit integer implementation when available
+
+=head1 SYNOPSIS
+
+ use Math::Int64 qw(uint64);
+ use Math::Int64::native_if_available;
+
+=head1 SEE ALSO
+
+L<Math::Int64>.
+
+=cut
+
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/UInt64.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/UInt64.pm
new file mode 100644
index 0000000000..6fc6d03ef2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Math/UInt64.pm
@@ -0,0 +1,32 @@
+package Math::UInt64;
+
+use strict;
+use warnings;
+
+use Math::Int64;
+
+sub import { goto &Math::Int64::import }
+
+1;
+
+# ABSTRACT: Manipulate 64 bit unsigned integers from Perl
+
+__END__
+
+=encoding UTF-8
+
+=head1 NAME
+
+Math::UInt64 - Manipulate 64 bit unsigned integers from Perl
+
+=head1 DESCRIPTION
+
+Math::UInt64 is just an alias for Math::Int64, the only reason it
+exists as an independent package is to allow L<Storable> to load it on
+demand.
+
+=head1 SEE ALSO
+
+L<Math::Int64>.
+
+=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
new file mode 100644
index 0000000000..c2f35b5f4c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA.pm
@@ -0,0 +1,74 @@
+package Mozilla::CA;
+
+use strict;
+our $VERSION = '20180117';
+
+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;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Mozilla::CA - Mozilla's CA cert bundle in PEM format
+
+=head1 SYNOPSIS
+
+ use IO::Socket::SSL;
+ use Mozilla::CA;
+
+ 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(),
+ )
+ || die "Can't connect: $@";
+
+ $client->verify_hostname($host, "http")
+ || die "hostname verification failure";
+
+=head1 DESCRIPTION
+
+Mozilla::CA provides a copy of Mozilla's bundle of Certificate Authority
+certificates in a form that can be consumed by modules and libraries
+based on OpenSSL.
+
+The module provide a single function:
+
+=over
+
+=item SSL_ca_file()
+
+Returns the absolute path to the Mozilla's CA cert bundle PEM file.
+
+=back
+
+=head1 SEE ALSO
+
+L<http://curl.haxx.se/docs/caextract.html>
+
+=head1 LICENSE
+
+For the bundled Mozilla CA PEM file the following applies:
+
+=over
+
+This Source Code Form is subject to the terms of the Mozilla Public
+License, v. 2.0. If a copy of the MPL was not distributed with this
+file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+=back
+
+The Mozilla::CA distribution itself is available under the same license.
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
new file mode 100644
index 0000000000..6e88a2cfd2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/CA/cacert.pem
@@ -0,0 +1,3467 @@
+##
+## Bundle of CA Root Certificates
+##
+## Certificate data from Mozilla as of: Wed Jan 17 04:12:05 2018 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:
+## https://hg.mozilla.org/releases/mozilla-release/raw-file/default/security/nss/lib/ckfw/builtins/certdata.txt
+##
+## It contains the certificates in 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 1.27.
+## SHA256: a3ac15b98179dd2f3c5de076d10b1d53048754372f7207c2f327510cdd78fbd8
+##
+
+
+GlobalSign Root CA
+==================
+-----BEGIN CERTIFICATE-----
+MIIDdTCCAl2gAwIBAgILBAAAAAABFUtaw5QwDQYJKoZIhvcNAQEFBQAwVzELMAkGA1UEBhMCQkUx
+GTAXBgNVBAoTEEdsb2JhbFNpZ24gbnYtc2ExEDAOBgNVBAsTB1Jvb3QgQ0ExGzAZBgNVBAMTEkds
+b2JhbFNpZ24gUm9vdCBDQTAeFw05ODA5MDExMjAwMDBaFw0yODAxMjgxMjAwMDBaMFcxCzAJBgNV
+BAYTAkJFMRkwFwYDVQQKExBHbG9iYWxTaWduIG52LXNhMRAwDgYDVQQLEwdSb290IENBMRswGQYD
+VQQDExJHbG9iYWxTaWduIFJvb3QgQ0EwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDa
+DuaZjc6j40+Kfvvxi4Mla+pIH/EqsLmVEQS98GPR4mdmzxzdzxtIK+6NiY6arymAZavpxy0Sy6sc
+THAHoT0KMM0VjU/43dSMUBUc71DuxC73/OlS8pF94G3VNTCOXkNz8kHp1Wrjsok6Vjk4bwY8iGlb
+Kk3Fp1S4bInMm/k8yuX9ifUSPJJ4ltbcdG6TRGHRjcdGsnUOhugZitVtbNV4FpWi6cgKOOvyJBNP
+c1STE4U6G7weNLWLBYy5d4ux2x8gkasJU26Qzns3dLlwR5EiUWMWea6xrkEmCMgZK9FGqkjWZCrX
+gzT/LCrBbBlDSgeF59N89iFo7+ryUp9/k5DPAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAPBgNV
+HRMBAf8EBTADAQH/MB0GA1UdDgQWBBRge2YaRQ2XyolQL30EzTSo//z9SzANBgkqhkiG9w0BAQUF
+AAOCAQEA1nPnfE920I2/7LqivjTFKDK1fPxsnCwrvQmeU79rXqoRSLblCKOzyj1hTdNGCbM+w6Dj
+Y1Ub8rrvrTnhQ7k4o+YviiY776BQVvnGCv04zcQLcFGUl5gE38NflNUVyRRBnMRddWQVDf9VMOyG
+j/8N7yy5Y0b2qvzfvGn9LhJIZJrglfCm7ymPAbEVtQwdpf5pLGkkeB6zpxxxYu7KyJesF12KwvhH
+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-----
+
+Verisign Class 3 Public Primary Certification Authority - G3
+============================================================
+-----BEGIN CERTIFICATE-----
+MIIEGjCCAwICEQCbfgZJoz5iudXukEhxKe9XMA0GCSqGSIb3DQEBBQUAMIHKMQswCQYDVQQGEwJV
+UzEXMBUGA1UEChMOVmVyaVNpZ24sIEluYy4xHzAdBgNVBAsTFlZlcmlTaWduIFRydXN0IE5ldHdv
+cmsxOjA4BgNVBAsTMShjKSAxOTk5IFZlcmlTaWduLCBJbmMuIC0gRm9yIGF1dGhvcml6ZWQgdXNl
+IG9ubHkxRTBDBgNVBAMTPFZlcmlTaWduIENsYXNzIDMgUHVibGljIFByaW1hcnkgQ2VydGlmaWNh
+dGlvbiBBdXRob3JpdHkgLSBHMzAeFw05OTEwMDEwMDAwMDBaFw0zNjA3MTYyMzU5NTlaMIHKMQsw
+CQYDVQQGEwJVUzEXMBUGA1UEChMOVmVyaVNpZ24sIEluYy4xHzAdBgNVBAsTFlZlcmlTaWduIFRy
+dXN0IE5ldHdvcmsxOjA4BgNVBAsTMShjKSAxOTk5IFZlcmlTaWduLCBJbmMuIC0gRm9yIGF1dGhv
+cml6ZWQgdXNlIG9ubHkxRTBDBgNVBAMTPFZlcmlTaWduIENsYXNzIDMgUHVibGljIFByaW1hcnkg
+Q2VydGlmaWNhdGlvbiBBdXRob3JpdHkgLSBHMzCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
+ggEBAMu6nFL8eB8aHm8bN3O9+MlrlBIwT/A2R/XQkQr1F8ilYcEWQE37imGQ5XYgwREGfassbqb1
+EUGO+i2tKmFZpGcmTNDovFJbcCAEWNF6yaRpvIMXZK0Fi7zQWM6NjPXr8EJJC52XJ2cybuGukxUc
+cLwgTS8Y3pKI6GyFVxEa6X7jJhFUokWWVYPKMIno3Nij7SqAP395ZVc+FSBmCC+Vk7+qRy+oRpfw
+EuL+wgorUeZ25rdGt+INpsyow0xZVYnm6FNcHOqd8GIWC6fJXwzw3sJ2zq/3avL6QaaiMxTJ5Xpj
+055iN9WFZZ4O5lMkdBteHRJTW8cs54NJOxWuimi5V5cCAwEAATANBgkqhkiG9w0BAQUFAAOCAQEA
+ERSWwauSCPc/L8my/uRan2Te2yFPhpk0djZX3dAVL8WtfxUfN2JzPtTnX84XA9s1+ivbrmAJXx5f
+j267Cz3qWhMeDGBvtcC1IyIuBwvLqXTLR7sdwdela8wv0kL9Sd2nic9TutoAWii/gt/4uhMdUIaC
+/Y4wjylGsB49Ndo4YhYYSq3mtlFs3q9i6wHQHiT+eo8SGhJouPtmmRQURVyu565pF4ErWjfJXir0
+xuKhXFSbplQAz/DxwceYMBo7Nhbbo27q/a2ywtrvAkcTisDxszGtTxzhT5yvDwyd93gN2PQ1VoDa
+t20Xj50egWTh/sVFuq1ruQp6Tk9LhO5L8X3dEQ==
+-----END CERTIFICATE-----
+
+Entrust.net Premium 2048 Secure Server CA
+=========================================
+-----BEGIN CERTIFICATE-----
+MIIEKjCCAxKgAwIBAgIEOGPe+DANBgkqhkiG9w0BAQUFADCBtDEUMBIGA1UEChMLRW50cnVzdC5u
+ZXQxQDA+BgNVBAsUN3d3dy5lbnRydXN0Lm5ldC9DUFNfMjA0OCBpbmNvcnAuIGJ5IHJlZi4gKGxp
+bWl0cyBsaWFiLikxJTAjBgNVBAsTHChjKSAxOTk5IEVudHJ1c3QubmV0IExpbWl0ZWQxMzAxBgNV
+BAMTKkVudHJ1c3QubmV0IENlcnRpZmljYXRpb24gQXV0aG9yaXR5ICgyMDQ4KTAeFw05OTEyMjQx
+NzUwNTFaFw0yOTA3MjQxNDE1MTJaMIG0MRQwEgYDVQQKEwtFbnRydXN0Lm5ldDFAMD4GA1UECxQ3
+d3d3LmVudHJ1c3QubmV0L0NQU18yMDQ4IGluY29ycC4gYnkgcmVmLiAobGltaXRzIGxpYWIuKTEl
+MCMGA1UECxMcKGMpIDE5OTkgRW50cnVzdC5uZXQgTGltaXRlZDEzMDEGA1UEAxMqRW50cnVzdC5u
+ZXQgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkgKDIwNDgpMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8A
+MIIBCgKCAQEArU1LqRKGsuqjIAcVFmQqK0vRvwtKTY7tgHalZ7d4QMBzQshowNtTK91euHaYNZOL
+Gp18EzoOH1u3Hs/lJBQesYGpjX24zGtLA/ECDNyrpUAkAH90lKGdCCmziAv1h3edVc3kw37XamSr
+hRSGlVuXMlBvPci6Zgzj/L24ScF2iUkZ/cCovYmjZy/Gn7xxGWC4LeksyZB2ZnuU4q941mVTXTzW
+nLLPKQP5L6RQstRIzgUyVYr9smRMDuSYB3Xbf9+5CFVghTAp+XtIpGmG4zU/HoZdenoVve8AjhUi
+VBcAkCaTvA5JaJG/+EfTnZVCwQ5N328mz8MYIWJmQ3DW1cAH4QIDAQABo0IwQDAOBgNVHQ8BAf8E
+BAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQUVeSB0RGAvtiJuQijMfmhJAkWuXAwDQYJ
+KoZIhvcNAQEFBQADggEBADubj1abMOdTmXx6eadNl9cZlZD7Bh/KM3xGY4+WZiT6QBshJ8rmcnPy
+T/4xmf3IDExoU8aAghOY+rat2l098c5u9hURlIIM7j+VrxGrD9cv3h8Dj1csHsm7mhpElesYT6Yf
+zX1XEC+bBAlahLVu2B064dae0Wx5XnkcFMXj0EyTO2U87d89vqbllRrDtRnDvV5bu/8j72gZyxKT
+J1wDLW8w0B62GqzeWvfRqqgnpv55gcR5mTNXuhKwqeBCbJPKVt7+bYQLCIt+jerXmCHG8+c8eS9e
+nNFMFY3h7CI3zJpDC5fcgJCNs2ebb0gIFVbPv/ErfF6adulZkMV8gzURZVE=
+-----END CERTIFICATE-----
+
+Baltimore CyberTrust Root
+=========================
+-----BEGIN CERTIFICATE-----
+MIIDdzCCAl+gAwIBAgIEAgAAuTANBgkqhkiG9w0BAQUFADBaMQswCQYDVQQGEwJJRTESMBAGA1UE
+ChMJQmFsdGltb3JlMRMwEQYDVQQLEwpDeWJlclRydXN0MSIwIAYDVQQDExlCYWx0aW1vcmUgQ3li
+ZXJUcnVzdCBSb290MB4XDTAwMDUxMjE4NDYwMFoXDTI1MDUxMjIzNTkwMFowWjELMAkGA1UEBhMC
+SUUxEjAQBgNVBAoTCUJhbHRpbW9yZTETMBEGA1UECxMKQ3liZXJUcnVzdDEiMCAGA1UEAxMZQmFs
+dGltb3JlIEN5YmVyVHJ1c3QgUm9vdDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAKME
+uyKrmD1X6CZymrV51Cni4eiVgLGw41uOKymaZN+hXe2wCQVt2yguzmKiYv60iNoS6zjrIZ3AQSsB
+UnuId9Mcj8e6uYi1agnnc+gRQKfRzMpijS3ljwumUNKoUMMo6vWrJYeKmpYcqWe4PwzV9/lSEy/C
+G9VwcPCPwBLKBsua4dnKM3p31vjsufFoREJIE9LAwqSuXmD+tqYF/LTdB1kC1FkYmGP1pWPgkAx9
+XbIGevOF6uvUA65ehD5f/xXtabz5OTZydc93Uk3zyZAsuT3lySNTPx8kmCFcB5kpvcY67Oduhjpr
+l3RjM71oGDHweI12v/yejl0qhqdNkNwnGjkCAwEAAaNFMEMwHQYDVR0OBBYEFOWdWTCCR1jMrPoI
+VDaGezq1BE3wMBIGA1UdEwEB/wQIMAYBAf8CAQMwDgYDVR0PAQH/BAQDAgEGMA0GCSqGSIb3DQEB
+BQUAA4IBAQCFDF2O5G9RaEIFoN27TyclhAO992T9Ldcw46QQF+vaKSm2eT929hkTI7gQCvlYpNRh
+cL0EYWoSihfVCr3FvDB81ukMJY2GQE/szKN+OMY3EU/t3WgxjkzSswF07r51XgdIGn9w/xZchMB5
+hbgF/X++ZRGjD8ACtPhSNzkE1akxehi/oCr0Epn3o0WC4zxe9Z2etciefC7IpJ5OCBRLbf1wbWsa
+Y71k5h+3zvDyny67G7fyUIhzksLi4xaNmjICq44Y3ekQEe5+NauQrz4wlHrQMz2nZQ/1/I6eYs9H
+RCwBXbsdtTLSR9I4LtD+gdwyah617jzV/OeBHRnDJELqYzmp
+-----END CERTIFICATE-----
+
+AddTrust External Root
+======================
+-----BEGIN CERTIFICATE-----
+MIIENjCCAx6gAwIBAgIBATANBgkqhkiG9w0BAQUFADBvMQswCQYDVQQGEwJTRTEUMBIGA1UEChML
+QWRkVHJ1c3QgQUIxJjAkBgNVBAsTHUFkZFRydXN0IEV4dGVybmFsIFRUUCBOZXR3b3JrMSIwIAYD
+VQQDExlBZGRUcnVzdCBFeHRlcm5hbCBDQSBSb290MB4XDTAwMDUzMDEwNDgzOFoXDTIwMDUzMDEw
+NDgzOFowbzELMAkGA1UEBhMCU0UxFDASBgNVBAoTC0FkZFRydXN0IEFCMSYwJAYDVQQLEx1BZGRU
+cnVzdCBFeHRlcm5hbCBUVFAgTmV0d29yazEiMCAGA1UEAxMZQWRkVHJ1c3QgRXh0ZXJuYWwgQ0Eg
+Um9vdDCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBALf3GjPm8gAELTngTlvtH7xsD821
++iO2zt6bETOXpClMfZOfvUq8k+0DGuOPz+VtUFrWlymUWoCwSXrbLpX9uMq/NzgtHj6RQa1wVsfw
+Tz/oMp50ysiQVOnGXw94nZpAPA6sYapeFI+eh6FqUNzXmk6vBbOmcZSccbNQYArHE504B4YCqOmo
+aSYYkKtMsE8jqzpPhNjfzp/haW+710LXa0Tkx63ubUFfclpxCDezeWWkWaCUN/cALw3CknLa0Dhy
+2xSoRcRdKn23tNbE7qzNE0S3ySvdQwAl+mG5aWpYIxG3pzOPVnVZ9c0p10a3CitlttNCbxWyuHv7
+7+ldU9U0WicCAwEAAaOB3DCB2TAdBgNVHQ4EFgQUrb2YejS0Jvf6xCZU7wO94CTLVBowCwYDVR0P
+BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wgZkGA1UdIwSBkTCBjoAUrb2YejS0Jvf6xCZU7wO94CTL
+VBqhc6RxMG8xCzAJBgNVBAYTAlNFMRQwEgYDVQQKEwtBZGRUcnVzdCBBQjEmMCQGA1UECxMdQWRk
+VHJ1c3QgRXh0ZXJuYWwgVFRQIE5ldHdvcmsxIjAgBgNVBAMTGUFkZFRydXN0IEV4dGVybmFsIENB
+IFJvb3SCAQEwDQYJKoZIhvcNAQEFBQADggEBALCb4IUlwtYj4g+WBpKdQZic2YR5gdkeWxQHIzZl
+j7DYd7usQWxHYINRsPkyPef89iYTx4AWpb9a/IfPeHmJIZriTAcKhjW88t5RxNKWt9x+Tu5w/Rw5
+6wwCURQtjr0W4MHfRnXnJK3s9EK0hZNwEGe6nQY1ShjTK3rMUUKhemPR5ruhxSvCNr4TDea9Y355
+e6cJDUCrat2PisP29owaQgVR1EX1n6diIWgVIEM8med8vSTYqZEXc4g/VhsxOBi0cQ+azcgOno4u
+G+GMmIPLHzHxREzGBHNJdmAPx/i9F4BrLunMTA5amnkPIAou1Z5jJh5VkpTYghdae9C8x49OhgQ=
+-----END CERTIFICATE-----
+
+Entrust Root Certification Authority
+====================================
+-----BEGIN CERTIFICATE-----
+MIIEkTCCA3mgAwIBAgIERWtQVDANBgkqhkiG9w0BAQUFADCBsDELMAkGA1UEBhMCVVMxFjAUBgNV
+BAoTDUVudHJ1c3QsIEluYy4xOTA3BgNVBAsTMHd3dy5lbnRydXN0Lm5ldC9DUFMgaXMgaW5jb3Jw
+b3JhdGVkIGJ5IHJlZmVyZW5jZTEfMB0GA1UECxMWKGMpIDIwMDYgRW50cnVzdCwgSW5jLjEtMCsG
+A1UEAxMkRW50cnVzdCBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5MB4XDTA2MTEyNzIwMjM0
+MloXDTI2MTEyNzIwNTM0MlowgbAxCzAJBgNVBAYTAlVTMRYwFAYDVQQKEw1FbnRydXN0LCBJbmMu
+MTkwNwYDVQQLEzB3d3cuZW50cnVzdC5uZXQvQ1BTIGlzIGluY29ycG9yYXRlZCBieSByZWZlcmVu
+Y2UxHzAdBgNVBAsTFihjKSAyMDA2IEVudHJ1c3QsIEluYy4xLTArBgNVBAMTJEVudHJ1c3QgUm9v
+dCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEB
+ALaVtkNC+sZtKm9I35RMOVcF7sN5EUFoNu3s/poBj6E4KPz3EEZmLk0eGrEaTsbRwJWIsMn/MYsz
+A9u3g3s+IIRe7bJWKKf44LlAcTfFy0cOlypowCKVYhXbR9n10Cv/gkvJrT7eTNuQgFA/CYqEAOww
+Cj0Yzfv9KlmaI5UXLEWeH25DeW0MXJj+SKfFI0dcXv1u5x609mhF0YaDW6KKjbHjKYD+JXGIrb68
+j6xSlkuqUY3kEzEZ6E5Nn9uss2rVvDlUccp6en+Q3X0dgNmBu1kmwhH+5pPi94DkZfs0Nw4pgHBN
+rziGLp5/V6+eF67rHMsoIV+2HNjnogQi+dPa2MsCAwEAAaOBsDCBrTAOBgNVHQ8BAf8EBAMCAQYw
+DwYDVR0TAQH/BAUwAwEB/zArBgNVHRAEJDAigA8yMDA2MTEyNzIwMjM0MlqBDzIwMjYxMTI3MjA1
+MzQyWjAfBgNVHSMEGDAWgBRokORnpKZTgMeGZqTx90tD+4S9bTAdBgNVHQ4EFgQUaJDkZ6SmU4DH
+hmak8fdLQ/uEvW0wHQYJKoZIhvZ9B0EABBAwDhsIVjcuMTo0LjADAgSQMA0GCSqGSIb3DQEBBQUA
+A4IBAQCT1DCw1wMgKtD5Y+iRDAUgqV8ZyntyTtSx29CW+1RaGSwMCPeyvIWonX9tO1KzKtvn1ISM
+Y/YPyyYBkVBs9F8U4pN0wBOeMDpQ47RgxRzwIkSNcUesyBrJ6ZuaAGAT/3B+XxFNSRuzFVJ7yVTa
+v52Vr2ua2J7p8eRDjeIRRDq/r72DQnNSi6q7pynP9WQcCk3RvKqsnyrQ/39/2n3qse0wJcGE2jTS
+W3iDVuycNsMm4hH2Z0kdkquM++v/eu6FSqdQgPCnXEqULl8FmTxSQeDNtGPPAUO6nIPcj2A781q0
+tHuu2guQOHXvgR1m0vdXcDazv/wor3ElhVsT/h5/WrQ8
+-----END CERTIFICATE-----
+
+GeoTrust Global CA
+==================
+-----BEGIN CERTIFICATE-----
+MIIDVDCCAjygAwIBAgIDAjRWMA0GCSqGSIb3DQEBBQUAMEIxCzAJBgNVBAYTAlVTMRYwFAYDVQQK
+Ew1HZW9UcnVzdCBJbmMuMRswGQYDVQQDExJHZW9UcnVzdCBHbG9iYWwgQ0EwHhcNMDIwNTIxMDQw
+MDAwWhcNMjIwNTIxMDQwMDAwWjBCMQswCQYDVQQGEwJVUzEWMBQGA1UEChMNR2VvVHJ1c3QgSW5j
+LjEbMBkGA1UEAxMSR2VvVHJ1c3QgR2xvYmFsIENBMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB
+CgKCAQEA2swYYzD99BcjGlZ+W988bDjkcbd4kdS8odhM+KhDtgPpTSEHCIjaWC9mOSm9BXiLnTjo
+BbdqfnGk5sRgprDvgOSJKA+eJdbtg/OtppHHmMlCGDUUna2YRpIuT8rxh0PBFpVXLVDviS2Aelet
+8u5fa9IAjbkU+BQVNdnARqN7csiRv8lVK83Qlz6cJmTM386DGXHKTubU1XupGc1V3sjs0l44U+Vc
+T4wt/lAjNvxm5suOpDkZALeVAjmRCw7+OC7RHQWa9k0+bw8HHa8sHo9gOeL6NlMTOdReJivbPagU
+vTLrGAMoUgRx5aszPeE4uwc2hGKceeoWMPRfwCvocWvk+QIDAQABo1MwUTAPBgNVHRMBAf8EBTAD
+AQH/MB0GA1UdDgQWBBTAephojYn7qwVkDBF9qn1luMrMTjAfBgNVHSMEGDAWgBTAephojYn7qwVk
+DBF9qn1luMrMTjANBgkqhkiG9w0BAQUFAAOCAQEANeMpauUvXVSOKVCUn5kaFOSPeCpilKInZ57Q
+zxpeR+nBsqTP3UEaBU6bS+5Kb1VSsyShNwrrZHYqLizz/Tt1kL/6cdjHPTfStQWVYrmm3ok9Nns4
+d0iXrKYgjy6myQzCsplFAMfOEVEiIuCl6rYVSAlk6l5PdPcFPseKUgzbFbS9bZvlxrFUaKnjaZC2
+mqUPuLk/IH2uSrW4nOQdtqvmlKXBx4Ot2/Unhw4EbNX/3aBd7YdStysVAq45pmp06drE57xNNB6p
+XE0zX5IJL4hmXXeXxx12E6nV5fEWCRE11azbJHFwLJhWC9kXtNHjUStedejV0NxPNO3CBWaAocvm
+Mw==
+-----END CERTIFICATE-----
+
+GeoTrust Universal CA
+=====================
+-----BEGIN CERTIFICATE-----
+MIIFaDCCA1CgAwIBAgIBATANBgkqhkiG9w0BAQUFADBFMQswCQYDVQQGEwJVUzEWMBQGA1UEChMN
+R2VvVHJ1c3QgSW5jLjEeMBwGA1UEAxMVR2VvVHJ1c3QgVW5pdmVyc2FsIENBMB4XDTA0MDMwNDA1
+MDAwMFoXDTI5MDMwNDA1MDAwMFowRTELMAkGA1UEBhMCVVMxFjAUBgNVBAoTDUdlb1RydXN0IElu
+Yy4xHjAcBgNVBAMTFUdlb1RydXN0IFVuaXZlcnNhbCBDQTCCAiIwDQYJKoZIhvcNAQEBBQADggIP
+ADCCAgoCggIBAKYVVaCjxuAfjJ0hUNfBvitbtaSeodlyWL0AG0y/YckUHUWCq8YdgNY96xCcOq9t
+JPi8cQGeBvV8Xx7BDlXKg5pZMK4ZyzBIle0iN430SppyZj6tlcDgFgDgEB8rMQ7XlFTTQjOgNB0e
+RXbdT8oYN+yFFXoZCPzVx5zw8qkuEKmS5j1YPakWaDwvdSEYfyh3peFhF7em6fgemdtzbvQKoiFs
+7tqqhZJmr/Z6a4LauiIINQ/PQvE1+mrufislzDoR5G2vc7J2Ha3QsnhnGqQ5HFELZ1aD/ThdDc7d
+8Lsrlh/eezJS/R27tQahsiFepdaVaH/wmZ7cRQg+59IJDTWU3YBOU5fXtQlEIGQWFwMCTFMNaN7V
+qnJNk22CDtucvc+081xdVHppCZbW2xHBjXWotM85yM48vCR85mLK4b19p71XZQvk/iXttmkQ3Cga
+Rr0BHdCXteGYO8A3ZNY9lO4L4fUorgtWv3GLIylBjobFS1J72HGrH4oVpjuDWtdYAVHGTEHZf9hB
+Z3KiKN9gg6meyHv8U3NyWfWTehd2Ds735VzZC1U0oqpbtWpU5xPKV+yXbfReBi9Fi1jUIxaS5BZu
+KGNZMN9QAZxjiRqf2xeUgnA3wySemkfWWspOqGmJch+RbNt+nhutxx9z3SxPGWX9f5NAEC7S8O08
+ni4oPmkmM8V7AgMBAAGjYzBhMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFNq7LqqwDLiIJlF0
+XG0D08DYj3rWMB8GA1UdIwQYMBaAFNq7LqqwDLiIJlF0XG0D08DYj3rWMA4GA1UdDwEB/wQEAwIB
+hjANBgkqhkiG9w0BAQUFAAOCAgEAMXjmx7XfuJRAyXHEqDXsRh3ChfMoWIawC/yOsjmPRFWrZIRc
+aanQmjg8+uUfNeVE44B5lGiku8SfPeE0zTBGi1QrlaXv9z+ZhP015s8xxtxqv6fXIwjhmF7DWgh2
+qaavdy+3YL1ERmrvl/9zlcGO6JP7/TG37FcREUWbMPEaiDnBTzynANXH/KttgCJwpQzgXQQpAvvL
+oJHRfNbDflDVnVi+QTjruXU8FdmbyUqDWcDaU/0zuzYYm4UPFd3uLax2k7nZAY1IEKj79TiG8dsK
+xr2EoyNB3tZ3b4XUhRxQ4K5RirqNPnbiucon8l+f725ZDQbYKxek0nxru18UGkiPGkzns0ccjkxF
+KyDuSN/n3QmOGKjaQI2SJhFTYXNd673nxE0pN2HrrDktZy4W1vUAg4WhzH92xH3kt0tm7wNFYGm2
+DFKWkoRepqO1pD4r2czYG0eq8kTaT/kD6PAUyz/zg97QwVTjt+gKN02LIFkDMBmhLMi9ER/frslK
+xfMnZmaGrGiR/9nmUxwPi1xpZQomyB40w11Re9epnAahNt3ViZS82eQtDF4JbAiXfKM9fJP/P6EU
+p8+1Xevb2xzEdt+Iub1FBZUbrvxGakyvSOPOrg/SfuvmbJxPgWp6ZKy7PtXny3YuxadIwVyQD8vI
+P/rmMuGNG2+k5o7Y+SlIis5z/iw=
+-----END CERTIFICATE-----
+
+GeoTrust Universal CA 2
+=======================
+-----BEGIN CERTIFICATE-----
+MIIFbDCCA1SgAwIBAgIBATANBgkqhkiG9w0BAQUFADBHMQswCQYDVQQGEwJVUzEWMBQGA1UEChMN
+R2VvVHJ1c3QgSW5jLjEgMB4GA1UEAxMXR2VvVHJ1c3QgVW5pdmVyc2FsIENBIDIwHhcNMDQwMzA0
+MDUwMDAwWhcNMjkwMzA0MDUwMDAwWjBHMQswCQYDVQQGEwJVUzEWMBQGA1UEChMNR2VvVHJ1c3Qg
+SW5jLjEgMB4GA1UEAxMXR2VvVHJ1c3QgVW5pdmVyc2FsIENBIDIwggIiMA0GCSqGSIb3DQEBAQUA
+A4ICDwAwggIKAoICAQCzVFLByT7y2dyxUxpZKeexw0Uo5dfR7cXFS6GqdHtXr0om/Nj1XqduGdt0
+DE81WzILAePb63p3NeqqWuDW6KFXlPCQo3RWlEQwAx5cTiuFJnSCegx2oG9NzkEtoBUGFF+3Qs17
+j1hhNNwqCPkuwwGmIkQcTAeC5lvO0Ep8BNMZcyfwqph/Lq9O64ceJHdqXbboW0W63MOhBW9Wjo8Q
+JqVJwy7XQYci4E+GymC16qFjwAGXEHm9ADwSbSsVsaxLse4YuU6W3Nx2/zu+z18DwPw76L5GG//a
+QMJS9/7jOvdqdzXQ2o3rXhhqMcceujwbKNZrVMaqW9eiLBsZzKIC9ptZvTdrhrVtgrrY6slWvKk2
+WP0+GfPtDCapkzj4T8FdIgbQl+rhrcZV4IErKIM6+vR7IVEAvlI4zs1meaj0gVbi0IMJR1FbUGrP
+20gaXT73y/Zl92zxlfgCOzJWgjl6W70viRu/obTo/3+NjN8D8WBOWBFM66M/ECuDmgFz2ZRthAAn
+ZqzwcEAJQpKtT5MNYQlRJNiS1QuUYbKHsu3/mjX/hVTK7URDrBs8FmtISgocQIgfksILAAX/8sgC
+SqSqqcyZlpwvWOB94b67B9xfBHJcMTTD7F8t4D1kkCLm0ey4Lt1ZrtmhN79UNdxzMk+MBB4zsslG
+8dhcyFVQyWi9qLo2CQIDAQABo2MwYTAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBR281Xh+qQ2
++/CfXGJx7Tz0RzgQKzAfBgNVHSMEGDAWgBR281Xh+qQ2+/CfXGJx7Tz0RzgQKzAOBgNVHQ8BAf8E
+BAMCAYYwDQYJKoZIhvcNAQEFBQADggIBAGbBxiPz2eAubl/oz66wsCVNK/g7WJtAJDday6sWSf+z
+dXkzoS9tcBc0kf5nfo/sm+VegqlVHy/c1FEHEv6sFj4sNcZj/NwQ6w2jqtB8zNHQL1EuxBRa3ugZ
+4T7GzKQp5y6EqgYweHZUcyiYWTjgAA1i00J9IZ+uPTqM1fp3DRgrFg5fNuH8KrUwJM/gYwx7WBr+
+mbpCErGR9Hxo4sjoryzqyX6uuyo9DRXcNJW2GHSoag/HtPQTxORb7QrSpJdMKu0vbBKJPfEncKpq
+A1Ihn0CoZ1Dy81of398j9tx4TuaYT1U6U+Pv8vSfx3zYWK8pIpe44L2RLrB27FcRz+8pRPPphXpg
+Y+RdM4kX2TGq2tbzGDVyz4crL2MjhF2EjD9XoIj8mZEoJmmZ1I+XRL6O1UixpCgp8RW04eWe3fiP
+pm8m1wk8OhwRDqZsN/etRIcsKMfYdIKz0G9KV7s1KSegi+ghp4dkNl3M2Basx7InQJJVOCiNUW7d
+FGdTbHFcJoRNdVq2fmBWqU2t+5sel/MN2dKXVHfaPRK34B7vCAas+YWH6aLcr34YEoP9VhdBLtUp
+gn2Z9DH2canPLAEnpQW5qrJITirvn5NSUZU8UnOOVkwXQMAJKOSLakhT2+zNVVXxxvjpoixMptEm
+X36vWkzaH6byHCx+rgIW0lbQL1dTR+iS
+-----END CERTIFICATE-----
+
+Visa eCommerce Root
+===================
+-----BEGIN CERTIFICATE-----
+MIIDojCCAoqgAwIBAgIQE4Y1TR0/BvLB+WUF1ZAcYjANBgkqhkiG9w0BAQUFADBrMQswCQYDVQQG
+EwJVUzENMAsGA1UEChMEVklTQTEvMC0GA1UECxMmVmlzYSBJbnRlcm5hdGlvbmFsIFNlcnZpY2Ug
+QXNzb2NpYXRpb24xHDAaBgNVBAMTE1Zpc2EgZUNvbW1lcmNlIFJvb3QwHhcNMDIwNjI2MDIxODM2
+WhcNMjIwNjI0MDAxNjEyWjBrMQswCQYDVQQGEwJVUzENMAsGA1UEChMEVklTQTEvMC0GA1UECxMm
+VmlzYSBJbnRlcm5hdGlvbmFsIFNlcnZpY2UgQXNzb2NpYXRpb24xHDAaBgNVBAMTE1Zpc2EgZUNv
+bW1lcmNlIFJvb3QwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCvV95WHm6h2mCxlCfL
+F9sHP4CFT8icttD0b0/Pmdjh28JIXDqsOTPHH2qLJj0rNfVIsZHBAk4ElpF7sDPwsRROEW+1QK8b
+RaVK7362rPKgH1g/EkZgPI2h4H3PVz4zHvtH8aoVlwdVZqW1LS7YgFmypw23RuwhY/81q6UCzyr0
+TP579ZRdhE2o8mCP2w4lPJ9zcc+U30rq299yOIzzlr3xF7zSujtFWsan9sYXiwGd/BmoKoMWuDpI
+/k4+oKsGGelT84ATB+0tvz8KPFUgOSwsAGl0lUq8ILKpeeUYiZGo3BxN77t+Nwtd/jmliFKMAGzs
+GHxBvfaLdXe6YJ2E5/4tAgMBAAGjQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEG
+MB0GA1UdDgQWBBQVOIMPPyw/cDMezUb+B4wg4NfDtzANBgkqhkiG9w0BAQUFAAOCAQEAX/FBfXxc
+CLkr4NWSR/pnXKUTwwMhmytMiUbPWU3J/qVAtmPN3XEolWcRzCSs00Rsca4BIGsDoo8Ytyk6feUW
+YFN4PMCvFYP3j1IzJL1kk5fui/fbGKhtcbP3LBfQdCVp9/5rPJS+TUtBjE7ic9DjkCJzQ83z7+pz
+zkWKsKZJ/0x9nXGIxHYdkFsd7v3M9+79YKWxehZx0RbQfBI8bGmX265fOZpwLwU8GUYEmSA20GBu
+YQa7FkKMcPcw++DbZqMAAb3mLNqRX6BGi01qnD093QVG/na/oAo85ADmJ7f/hC3euiInlhBx6yLt
+398znM/jra6O1I7mT1GvFpLgXPYHDw==
+-----END CERTIFICATE-----
+
+Comodo AAA Services root
+========================
+-----BEGIN CERTIFICATE-----
+MIIEMjCCAxqgAwIBAgIBATANBgkqhkiG9w0BAQUFADB7MQswCQYDVQQGEwJHQjEbMBkGA1UECAwS
+R3JlYXRlciBNYW5jaGVzdGVyMRAwDgYDVQQHDAdTYWxmb3JkMRowGAYDVQQKDBFDb21vZG8gQ0Eg
+TGltaXRlZDEhMB8GA1UEAwwYQUFBIENlcnRpZmljYXRlIFNlcnZpY2VzMB4XDTA0MDEwMTAwMDAw
+MFoXDTI4MTIzMTIzNTk1OVowezELMAkGA1UEBhMCR0IxGzAZBgNVBAgMEkdyZWF0ZXIgTWFuY2hl
+c3RlcjEQMA4GA1UEBwwHU2FsZm9yZDEaMBgGA1UECgwRQ29tb2RvIENBIExpbWl0ZWQxITAfBgNV
+BAMMGEFBQSBDZXJ0aWZpY2F0ZSBTZXJ2aWNlczCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
+ggEBAL5AnfRu4ep2hxxNRUSOvkbIgwadwSr+GB+O5AL686tdUIoWMQuaBtDFcCLNSS1UY8y2bmhG
+C1Pqy0wkwLxyTurxFa70VJoSCsN6sjNg4tqJVfMiWPPe3M/vg4aijJRPn2jymJBGhCfHdr/jzDUs
+i14HZGWCwEiwqJH5YZ92IFCokcdmtet4YgNW8IoaE+oxox6gmf049vYnMlhvB/VruPsUK6+3qszW
+Y19zjNoFmag4qMsXeDZRrOme9Hg6jc8P2ULimAyrL58OAd7vn5lJ8S3frHRNG5i1R8XlKdH5kBjH
+Ypy+g8cmez6KJcfA3Z3mNWgQIJ2P2N7Sw4ScDV7oL8kCAwEAAaOBwDCBvTAdBgNVHQ4EFgQUoBEK
+Iz6W8Qfs4q8p74Klf9AwpLQwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wewYDVR0f
+BHQwcjA4oDagNIYyaHR0cDovL2NybC5jb21vZG9jYS5jb20vQUFBQ2VydGlmaWNhdGVTZXJ2aWNl
+cy5jcmwwNqA0oDKGMGh0dHA6Ly9jcmwuY29tb2RvLm5ldC9BQUFDZXJ0aWZpY2F0ZVNlcnZpY2Vz
+LmNybDANBgkqhkiG9w0BAQUFAAOCAQEACFb8AvCb6P+k+tZ7xkSAzk/ExfYAWMymtrwUSWgEdujm
+7l3sAg9g1o1QGE8mTgHj5rCl7r+8dFRBv/38ErjHT1r0iWAFf2C3BUrz9vHCv8S5dIa2LX1rzNLz
+Rt0vxuBqw8M0Ayx9lt1awg6nCpnBBYurDC/zXDrPbDdVCYfeU0BsWO/8tqtlbgT2G9w84FoVxp7Z
+8VlIMCFlA2zs6SFz7JsDoeA3raAVGI/6ugLOpyypEBMs1OUIJqsil2D4kF501KKaU73yqWjgom7C
+12yxow+ev+to51byrvLjKzg6CYG1a4XXvi3tPxq3smPi9WIsgtRqAEFQ8TmDn5XpNpaYbg==
+-----END CERTIFICATE-----
+
+QuoVadis Root CA
+================
+-----BEGIN CERTIFICATE-----
+MIIF0DCCBLigAwIBAgIEOrZQizANBgkqhkiG9w0BAQUFADB/MQswCQYDVQQGEwJCTTEZMBcGA1UE
+ChMQUXVvVmFkaXMgTGltaXRlZDElMCMGA1UECxMcUm9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0
+eTEuMCwGA1UEAxMlUXVvVmFkaXMgUm9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTAeFw0wMTAz
+MTkxODMzMzNaFw0yMTAzMTcxODMzMzNaMH8xCzAJBgNVBAYTAkJNMRkwFwYDVQQKExBRdW9WYWRp
+cyBMaW1pdGVkMSUwIwYDVQQLExxSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5MS4wLAYDVQQD
+EyVRdW9WYWRpcyBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5MIIBIjANBgkqhkiG9w0BAQEF
+AAOCAQ8AMIIBCgKCAQEAv2G1lVO6V/z68mcLOhrfEYBklbTRvM16z/Ypli4kVEAkOPcahdxYTMuk
+J0KX0J+DisPkBgNbAKVRHnAEdOLB1Dqr1607BxgFjv2DrOpm2RgbaIr1VxqYuvXtdj182d6UajtL
+F8HVj71lODqV0D1VNk7feVcxKh7YWWVJWCCYfqtffp/p1k3sg3Spx2zY7ilKhSoGFPlU5tPaZQeL
+YzcS19Dsw3sgQUSj7cugF+FxZc4dZjH3dgEZyH0DWLaVSR2mEiboxgx24ONmy+pdpibu5cxfvWen
+AScOospUxbF6lR1xHkopigPcakXBpBlebzbNw6Kwt/5cOOJSvPhEQ+aQuwIDAQABo4ICUjCCAk4w
+PQYIKwYBBQUHAQEEMTAvMC0GCCsGAQUFBzABhiFodHRwczovL29jc3AucXVvdmFkaXNvZmZzaG9y
+ZS5jb20wDwYDVR0TAQH/BAUwAwEB/zCCARoGA1UdIASCAREwggENMIIBCQYJKwYBBAG+WAABMIH7
+MIHUBggrBgEFBQcCAjCBxxqBxFJlbGlhbmNlIG9uIHRoZSBRdW9WYWRpcyBSb290IENlcnRpZmlj
+YXRlIGJ5IGFueSBwYXJ0eSBhc3N1bWVzIGFjY2VwdGFuY2Ugb2YgdGhlIHRoZW4gYXBwbGljYWJs
+ZSBzdGFuZGFyZCB0ZXJtcyBhbmQgY29uZGl0aW9ucyBvZiB1c2UsIGNlcnRpZmljYXRpb24gcHJh
+Y3RpY2VzLCBhbmQgdGhlIFF1b1ZhZGlzIENlcnRpZmljYXRlIFBvbGljeS4wIgYIKwYBBQUHAgEW
+Fmh0dHA6Ly93d3cucXVvdmFkaXMuYm0wHQYDVR0OBBYEFItLbe3TKbkGGew5Oanwl4Rqy+/fMIGu
+BgNVHSMEgaYwgaOAFItLbe3TKbkGGew5Oanwl4Rqy+/foYGEpIGBMH8xCzAJBgNVBAYTAkJNMRkw
+FwYDVQQKExBRdW9WYWRpcyBMaW1pdGVkMSUwIwYDVQQLExxSb290IENlcnRpZmljYXRpb24gQXV0
+aG9yaXR5MS4wLAYDVQQDEyVRdW9WYWRpcyBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5ggQ6
+tlCLMA4GA1UdDwEB/wQEAwIBBjANBgkqhkiG9w0BAQUFAAOCAQEAitQUtf70mpKnGdSkfnIYj9lo
+fFIk3WdvOXrEql494liwTXCYhGHoG+NpGA7O+0dQoE7/8CQfvbLO9Sf87C9TqnN7Az10buYWnuul
+LsS/VidQK2K6vkscPFVcQR0kvoIgR13VRH56FmjffU1RcHhXHTMe/QKZnAzNCgVPx7uOpHX6Sm2x
+gI4JVrmcGmD+XcHXetwReNDWXcG31a0ymQM6isxUJTkxgXsTIlG6Rmyhu576BGxJJnSP0nPrzDCi
+5upZIof4l/UO/erMkqQWxFIY6iHOsfHmhIHluqmGKPJDWl0Snawe2ajlCmqnf6CHKc/yiU3U7MXi
+5nrQNiOKSnQ2+Q==
+-----END CERTIFICATE-----
+
+QuoVadis Root CA 2
+==================
+-----BEGIN CERTIFICATE-----
+MIIFtzCCA5+gAwIBAgICBQkwDQYJKoZIhvcNAQEFBQAwRTELMAkGA1UEBhMCQk0xGTAXBgNVBAoT
+EFF1b1ZhZGlzIExpbWl0ZWQxGzAZBgNVBAMTElF1b1ZhZGlzIFJvb3QgQ0EgMjAeFw0wNjExMjQx
+ODI3MDBaFw0zMTExMjQxODIzMzNaMEUxCzAJBgNVBAYTAkJNMRkwFwYDVQQKExBRdW9WYWRpcyBM
+aW1pdGVkMRswGQYDVQQDExJRdW9WYWRpcyBSb290IENBIDIwggIiMA0GCSqGSIb3DQEBAQUAA4IC
+DwAwggIKAoICAQCaGMpLlA0ALa8DKYrwD4HIrkwZhR0In6spRIXzL4GtMh6QRr+jhiYaHv5+HBg6
+XJxgFyo6dIMzMH1hVBHL7avg5tKifvVrbxi3Cgst/ek+7wrGsxDp3MJGF/hd/aTa/55JWpzmM+Yk
+lvc/ulsrHHo1wtZn/qtmUIttKGAr79dgw8eTvI02kfN/+NsRE8Scd3bBrrcCaoF6qUWD4gXmuVbB
+lDePSHFjIuwXZQeVikvfj8ZaCuWw419eaxGrDPmF60Tp+ARz8un+XJiM9XOva7R+zdRcAitMOeGy
+lZUtQofX1bOQQ7dsE/He3fbE+Ik/0XX1ksOR1YqI0JDs3G3eicJlcZaLDQP9nL9bFqyS2+r+eXyt
+66/3FsvbzSUr5R/7mp/iUcw6UwxI5g69ybR2BlLmEROFcmMDBOAENisgGQLodKcftslWZvB1Jdxn
+wQ5hYIizPtGo/KPaHbDRsSNU30R2be1B2MGyIrZTHN81Hdyhdyox5C315eXbyOD/5YDXC2Og/zOh
+D7osFRXql7PSorW+8oyWHhqPHWykYTe5hnMz15eWniN9gqRMgeKh0bpnX5UHoycR7hYQe7xFSkyy
+BNKr79X9DFHOUGoIMfmR2gyPZFwDwzqLID9ujWc9Otb+fVuIyV77zGHcizN300QyNQliBJIWENie
+J0f7OyHj+OsdWwIDAQABo4GwMIGtMA8GA1UdEwEB/wQFMAMBAf8wCwYDVR0PBAQDAgEGMB0GA1Ud
+DgQWBBQahGK8SEwzJQTU7tD2A8QZRtGUazBuBgNVHSMEZzBlgBQahGK8SEwzJQTU7tD2A8QZRtGU
+a6FJpEcwRTELMAkGA1UEBhMCQk0xGTAXBgNVBAoTEFF1b1ZhZGlzIExpbWl0ZWQxGzAZBgNVBAMT
+ElF1b1ZhZGlzIFJvb3QgQ0EgMoICBQkwDQYJKoZIhvcNAQEFBQADggIBAD4KFk2fBluornFdLwUv
+Z+YTRYPENvbzwCYMDbVHZF34tHLJRqUDGCdViXh9duqWNIAXINzng/iN/Ae42l9NLmeyhP3ZRPx3
+UIHmfLTJDQtyU/h2BwdBR5YM++CCJpNVjP4iH2BlfF/nJrP3MpCYUNQ3cVX2kiF495V5+vgtJodm
+VjB3pjd4M1IQWK4/YY7yarHvGH5KWWPKjaJW1acvvFYfzznB4vsKqBUsfU16Y8Zsl0Q80m/DShcK
++JDSV6IZUaUtl0HaB0+pUNqQjZRG4T7wlP0QADj1O+hA4bRuVhogzG9Yje0uRY/W6ZM/57Es3zrW
+IozchLsib9D45MY56QSIPMO661V6bYCZJPVsAfv4l7CUW+v90m/xd2gNNWQjrLhVoQPRTUIZ3Ph1
+WVaj+ahJefivDrkRoHy3au000LYmYjgahwz46P0u05B/B5EqHdZ+XIWDmbA4CD/pXvk1B+TJYm5X
+f6dQlfe6yJvmjqIBxdZmv3lh8zwc4bmCXF2gw+nYSL0ZohEUGW6yhhtoPkg3Goi3XZZenMfvJ2II
+4pEZXNLxId26F0KCl3GBUzGpn/Z9Yr9y4aOTHcyKJloJONDO1w2AFrR4pTqHTI2KpdVGl/IsELm8
+VCLAAVBpQ570su9t+Oza8eOx79+Rj1QqCyXBJhnEUhAFZdWCEOrCMc0u
+-----END CERTIFICATE-----
+
+QuoVadis Root CA 3
+==================
+-----BEGIN CERTIFICATE-----
+MIIGnTCCBIWgAwIBAgICBcYwDQYJKoZIhvcNAQEFBQAwRTELMAkGA1UEBhMCQk0xGTAXBgNVBAoT
+EFF1b1ZhZGlzIExpbWl0ZWQxGzAZBgNVBAMTElF1b1ZhZGlzIFJvb3QgQ0EgMzAeFw0wNjExMjQx
+OTExMjNaFw0zMTExMjQxOTA2NDRaMEUxCzAJBgNVBAYTAkJNMRkwFwYDVQQKExBRdW9WYWRpcyBM
+aW1pdGVkMRswGQYDVQQDExJRdW9WYWRpcyBSb290IENBIDMwggIiMA0GCSqGSIb3DQEBAQUAA4IC
+DwAwggIKAoICAQDMV0IWVJzmmNPTTe7+7cefQzlKZbPoFog02w1ZkXTPkrgEQK0CSzGrvI2RaNgg
+DhoB4hp7Thdd4oq3P5kazethq8Jlph+3t723j/z9cI8LoGe+AaJZz3HmDyl2/7FWeUUrH556VOij
+KTVopAFPD6QuN+8bv+OPEKhyq1hX51SGyMnzW9os2l2ObjyjPtr7guXd8lyyBTNvijbO0BNO/79K
+DDRMpsMhvVAEVeuxu537RR5kFd5VAYwCdrXLoT9CabwvvWhDFlaJKjdhkf2mrk7AyxRllDdLkgbv
+BNDInIjbC3uBr7E9KsRlOni27tyAsdLTmZw67mtaa7ONt9XOnMK+pUsvFrGeaDsGb659n/je7Mwp
+p5ijJUMv7/FfJuGITfhebtfZFG4ZM2mnO4SJk8RTVROhUXhA+LjJou57ulJCg54U7QVSWllWp5f8
+nT8KKdjcT5EOE7zelaTfi5m+rJsziO+1ga8bxiJTyPbH7pcUsMV8eFLI8M5ud2CEpukqdiDtWAEX
+MJPpGovgc2PZapKUSU60rUqFxKMiMPwJ7Wgic6aIDFUhWMXhOp8q3crhkODZc6tsgLjoC2SToJyM
+Gf+z0gzskSaHirOi4XCPLArlzW1oUevaPwV/izLmE1xr/l9A4iLItLRkT9a6fUg+qGkM17uGcclz
+uD87nSVL2v9A6wIDAQABo4IBlTCCAZEwDwYDVR0TAQH/BAUwAwEB/zCB4QYDVR0gBIHZMIHWMIHT
+BgkrBgEEAb5YAAMwgcUwgZMGCCsGAQUFBwICMIGGGoGDQW55IHVzZSBvZiB0aGlzIENlcnRpZmlj
+YXRlIGNvbnN0aXR1dGVzIGFjY2VwdGFuY2Ugb2YgdGhlIFF1b1ZhZGlzIFJvb3QgQ0EgMyBDZXJ0
+aWZpY2F0ZSBQb2xpY3kgLyBDZXJ0aWZpY2F0aW9uIFByYWN0aWNlIFN0YXRlbWVudC4wLQYIKwYB
+BQUHAgEWIWh0dHA6Ly93d3cucXVvdmFkaXNnbG9iYWwuY29tL2NwczALBgNVHQ8EBAMCAQYwHQYD
+VR0OBBYEFPLAE+CCQz777i9nMpY1XNu4ywLQMG4GA1UdIwRnMGWAFPLAE+CCQz777i9nMpY1XNu4
+ywLQoUmkRzBFMQswCQYDVQQGEwJCTTEZMBcGA1UEChMQUXVvVmFkaXMgTGltaXRlZDEbMBkGA1UE
+AxMSUXVvVmFkaXMgUm9vdCBDQSAzggIFxjANBgkqhkiG9w0BAQUFAAOCAgEAT62gLEz6wPJv92ZV
+qyM07ucp2sNbtrCD2dDQ4iH782CnO11gUyeim/YIIirnv6By5ZwkajGxkHon24QRiSemd1o417+s
+hvzuXYO8BsbRd2sPbSQvS3pspweWyuOEn62Iix2rFo1bZhfZFvSLgNLd+LJ2w/w4E6oM3kJpK27z
+POuAJ9v1pkQNn1pVWQvVDVJIxa6f8i+AxeoyUDUSly7B4f/xI4hROJ/yZlZ25w9Rl6VSDE1JUZU2
+Pb+iSwwQHYaZTKrzchGT5Or2m9qoXadNt54CrnMAyNojA+j56hl0YgCUyyIgvpSnWbWCar6ZeXqp
+8kokUvd0/bpO5qgdAm6xDYBEwa7TIzdfu4V8K5Iu6H6li92Z4b8nby1dqnuH/grdS/yO9SbkbnBC
+bjPsMZ57k8HkyWkaPcBrTiJt7qtYTcbQQcEr6k8Sh17rRdhs9ZgC06DYVYoGmRmioHfRMJ6szHXu
+g/WwYjnPbFfiTNKRCw51KBuav/0aQ/HKd/s7j2G4aSgWQgRecCocIdiP4b0jWy10QJLZYxkNc91p
+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-----
+
+Sonera Class 2 Root CA
+======================
+-----BEGIN CERTIFICATE-----
+MIIDIDCCAgigAwIBAgIBHTANBgkqhkiG9w0BAQUFADA5MQswCQYDVQQGEwJGSTEPMA0GA1UEChMG
+U29uZXJhMRkwFwYDVQQDExBTb25lcmEgQ2xhc3MyIENBMB4XDTAxMDQwNjA3Mjk0MFoXDTIxMDQw
+NjA3Mjk0MFowOTELMAkGA1UEBhMCRkkxDzANBgNVBAoTBlNvbmVyYTEZMBcGA1UEAxMQU29uZXJh
+IENsYXNzMiBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAJAXSjWdyvANlsdE+hY3
+/Ei9vX+ALTU74W+oZ6m/AxxNjG8yR9VBaKQTBME1DJqEQ/xcHf+Js+gXGM2RX/uJ4+q/Tl18GybT
+dXnt5oTjV+WtKcT0OijnpXuENmmz/V52vaMtmdOQTiMofRhj8VQ7Jp12W5dCsv+u8E7s3TmVToMG
+f+dJQMjFAbJUWmYdPfz56TwKnoG4cPABi+QjVHzIrviQHgCWctRUz2EjvOr7nQKV0ba5cTppCD8P
+tOFCx4j1P5iop7oc4HFx71hXgVB6XGt0Rg6DA5jDjqhu8nYybieDwnPz3BjotJPqdURrBGAgcVeH
+nfO+oJAjPYok4doh28MCAwEAAaMzMDEwDwYDVR0TAQH/BAUwAwEB/zARBgNVHQ4ECgQISqCqWITT
+XjwwCwYDVR0PBAQDAgEGMA0GCSqGSIb3DQEBBQUAA4IBAQBazof5FnIVV0sd2ZvnoiYw7JNn39Yt
+0jSv9zilzqsWuasvfDXLrNAPtEwr/IDva4yRXzZ299uzGxnq9LIR/WFxRL8oszodv7ND6J+/3DEI
+cbCdjdY0RzKQxmUk96BKfARzjzlvF4xytb1LyHr4e4PDKE6cCepnP7JnBBvDFNr450kkkdAdavph
+Oe9r5yF1BgfYErQhIHBCcYHaPJo2vqZbDWpsmh+Re/n570K6Tk6ezAyNlNzZRZxe7EJQY670XcSx
+EtzKO6gunRRaBXW37Ndj4ro1tgQIkejanZz2ZrUYrAqmVCY0M9IbwdR/GjqOC6oybtv8TyWf2TLH
+llpwrN9M
+-----END CERTIFICATE-----
+
+Camerfirma Chambers of Commerce Root
+====================================
+-----BEGIN CERTIFICATE-----
+MIIEvTCCA6WgAwIBAgIBADANBgkqhkiG9w0BAQUFADB/MQswCQYDVQQGEwJFVTEnMCUGA1UEChMe
+QUMgQ2FtZXJmaXJtYSBTQSBDSUYgQTgyNzQzMjg3MSMwIQYDVQQLExpodHRwOi8vd3d3LmNoYW1i
+ZXJzaWduLm9yZzEiMCAGA1UEAxMZQ2hhbWJlcnMgb2YgQ29tbWVyY2UgUm9vdDAeFw0wMzA5MzAx
+NjEzNDNaFw0zNzA5MzAxNjEzNDRaMH8xCzAJBgNVBAYTAkVVMScwJQYDVQQKEx5BQyBDYW1lcmZp
+cm1hIFNBIENJRiBBODI3NDMyODcxIzAhBgNVBAsTGmh0dHA6Ly93d3cuY2hhbWJlcnNpZ24ub3Jn
+MSIwIAYDVQQDExlDaGFtYmVycyBvZiBDb21tZXJjZSBSb290MIIBIDANBgkqhkiG9w0BAQEFAAOC
+AQ0AMIIBCAKCAQEAtzZV5aVdGDDg2olUkfzIx1L4L1DZ77F1c2VHfRtbunXF/KGIJPov7coISjlU
+xFF6tdpg6jg8gbLL8bvZkSM/SAFwdakFKq0fcfPJVD0dBmpAPrMMhe5cG3nCYsS4No41XQEMIwRH
+NaqbYE6gZj3LJgqcQKH0XZi/caulAGgq7YN6D6IUtdQis4CwPAxaUWktWBiP7Zme8a7ileb2R6jW
+DA+wWFjbw2Y3npuRVDM30pQcakjJyfKl2qUMI/cjDpwyVV5xnIQFUZot/eZOKjRa3spAN2cMVCFV
+d9oKDMyXroDclDZK9D7ONhMeU+SsTjoF7Nuucpw4i9A5O4kKPnf+dQIBA6OCAUQwggFAMBIGA1Ud
+EwEB/wQIMAYBAf8CAQwwPAYDVR0fBDUwMzAxoC+gLYYraHR0cDovL2NybC5jaGFtYmVyc2lnbi5v
+cmcvY2hhbWJlcnNyb290LmNybDAdBgNVHQ4EFgQU45T1sU3p26EpW1eLTXYGduHRooowDgYDVR0P
+AQH/BAQDAgEGMBEGCWCGSAGG+EIBAQQEAwIABzAnBgNVHREEIDAegRxjaGFtYmVyc3Jvb3RAY2hh
+bWJlcnNpZ24ub3JnMCcGA1UdEgQgMB6BHGNoYW1iZXJzcm9vdEBjaGFtYmVyc2lnbi5vcmcwWAYD
+VR0gBFEwTzBNBgsrBgEEAYGHLgoDATA+MDwGCCsGAQUFBwIBFjBodHRwOi8vY3BzLmNoYW1iZXJz
+aWduLm9yZy9jcHMvY2hhbWJlcnNyb290Lmh0bWwwDQYJKoZIhvcNAQEFBQADggEBAAxBl8IahsAi
+fJ/7kPMa0QOx7xP5IV8EnNrJpY0nbJaHkb5BkAFyk+cefV/2icZdp0AJPaxJRUXcLo0waLIJuvvD
+L8y6C98/d3tGfToSJI6WjzwFCm/SlCgdbQzALogi1djPHRPH8EjX1wWnz8dHnjs8NMiAT9QUu/wN
+UPf6s+xCX6ndbcj0dc97wXImsQEcXCz9ek60AcUFV7nnPKoF2YjpB0ZBzu9Bga5Y34OirsrXdx/n
+ADydb47kMgkdTXg0eDQ8lJsm7U9xxhl6vSAiSFr+S30Dt+dYvsYyTnQeaN2oaFuzPu5ifdmA6Ap1
+erfutGWaIZDgqtCYvDi1czyL+Nw=
+-----END CERTIFICATE-----
+
+Camerfirma Global Chambersign Root
+==================================
+-----BEGIN CERTIFICATE-----
+MIIExTCCA62gAwIBAgIBADANBgkqhkiG9w0BAQUFADB9MQswCQYDVQQGEwJFVTEnMCUGA1UEChMe
+QUMgQ2FtZXJmaXJtYSBTQSBDSUYgQTgyNzQzMjg3MSMwIQYDVQQLExpodHRwOi8vd3d3LmNoYW1i
+ZXJzaWduLm9yZzEgMB4GA1UEAxMXR2xvYmFsIENoYW1iZXJzaWduIFJvb3QwHhcNMDMwOTMwMTYx
+NDE4WhcNMzcwOTMwMTYxNDE4WjB9MQswCQYDVQQGEwJFVTEnMCUGA1UEChMeQUMgQ2FtZXJmaXJt
+YSBTQSBDSUYgQTgyNzQzMjg3MSMwIQYDVQQLExpodHRwOi8vd3d3LmNoYW1iZXJzaWduLm9yZzEg
+MB4GA1UEAxMXR2xvYmFsIENoYW1iZXJzaWduIFJvb3QwggEgMA0GCSqGSIb3DQEBAQUAA4IBDQAw
+ggEIAoIBAQCicKLQn0KuWxfH2H3PFIP8T8mhtxOviteePgQKkotgVvq0Mi+ITaFgCPS3CU6gSS9J
+1tPfnZdan5QEcOw/Wdm3zGaLmFIoCQLfxS+EjXqXd7/sQJ0lcqu1PzKY+7e3/HKE5TWH+VX6ox8O
+by4o3Wmg2UIQxvi1RMLQQ3/bvOSiPGpVeAp3qdjqGTK3L/5cPxvusZjsyq16aUXjlg9V9ubtdepl
+6DJWk0aJqCWKZQbua795B9Dxt6/tLE2Su8CoX6dnfQTyFQhwrJLWfQTSM/tMtgsL+xrJxI0DqX5c
+8lCrEqWhz0hQpe/SyBoT+rB/sYIcd2oPX9wLlY/vQ37mRQklAgEDo4IBUDCCAUwwEgYDVR0TAQH/
+BAgwBgEB/wIBDDA/BgNVHR8EODA2MDSgMqAwhi5odHRwOi8vY3JsLmNoYW1iZXJzaWduLm9yZy9j
+aGFtYmVyc2lnbnJvb3QuY3JsMB0GA1UdDgQWBBRDnDafsJ4wTcbOX60Qq+UDpfqpFDAOBgNVHQ8B
+Af8EBAMCAQYwEQYJYIZIAYb4QgEBBAQDAgAHMCoGA1UdEQQjMCGBH2NoYW1iZXJzaWducm9vdEBj
+aGFtYmVyc2lnbi5vcmcwKgYDVR0SBCMwIYEfY2hhbWJlcnNpZ25yb290QGNoYW1iZXJzaWduLm9y
+ZzBbBgNVHSAEVDBSMFAGCysGAQQBgYcuCgEBMEEwPwYIKwYBBQUHAgEWM2h0dHA6Ly9jcHMuY2hh
+bWJlcnNpZ24ub3JnL2Nwcy9jaGFtYmVyc2lnbnJvb3QuaHRtbDANBgkqhkiG9w0BAQUFAAOCAQEA
+PDtwkfkEVCeR4e3t/mh/YV3lQWVPMvEYBZRqHN4fcNs+ezICNLUMbKGKfKX0j//U2K0X1S0E0T9Y
+gOKBWYi+wONGkyT+kL0mojAt6JcmVzWJdJYY9hXiryQZVgICsroPFOrGimbBhkVVi76SvpykBMdJ
+PJ7oKXqJ1/6v/2j1pReQvayZzKWGVwlnRtvWFsJG8eSpUPWP0ZIV018+xgBJOm5YstHRJw0lyDL4
+IBHNfTIzSJRUTN3cecQwn+uOuFW114hcxWokPbLTBQNRxgfvzBRydD1ucs4YKIxKoHflCStFREes
+t2d/AYoFWpO+ocH/+OcOZ6RHSXZddZAa9SaP8A==
+-----END CERTIFICATE-----
+
+XRamp Global CA Root
+====================
+-----BEGIN CERTIFICATE-----
+MIIEMDCCAxigAwIBAgIQUJRs7Bjq1ZxN1ZfvdY+grTANBgkqhkiG9w0BAQUFADCBgjELMAkGA1UE
+BhMCVVMxHjAcBgNVBAsTFXd3dy54cmFtcHNlY3VyaXR5LmNvbTEkMCIGA1UEChMbWFJhbXAgU2Vj
+dXJpdHkgU2VydmljZXMgSW5jMS0wKwYDVQQDEyRYUmFtcCBHbG9iYWwgQ2VydGlmaWNhdGlvbiBB
+dXRob3JpdHkwHhcNMDQxMTAxMTcxNDA0WhcNMzUwMTAxMDUzNzE5WjCBgjELMAkGA1UEBhMCVVMx
+HjAcBgNVBAsTFXd3dy54cmFtcHNlY3VyaXR5LmNvbTEkMCIGA1UEChMbWFJhbXAgU2VjdXJpdHkg
+U2VydmljZXMgSW5jMS0wKwYDVQQDEyRYUmFtcCBHbG9iYWwgQ2VydGlmaWNhdGlvbiBBdXRob3Jp
+dHkwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCYJB69FbS638eMpSe2OAtp87ZOqCwu
+IR1cRN8hXX4jdP5efrRKt6atH67gBhbim1vZZ3RrXYCPKZ2GG9mcDZhtdhAoWORlsH9KmHmf4MMx
+foArtYzAQDsRhtDLooY2YKTVMIJt2W7QDxIEM5dfT2Fa8OT5kavnHTu86M/0ay00fOJIYRyO82FE
+zG+gSqmUsE3a56k0enI4qEHMPJQRfevIpoy3hsvKMzvZPTeL+3o+hiznc9cKV6xkmxnr9A8ECIqs
+AxcZZPRaJSKNNCyy9mgdEm3Tih4U2sSPpuIjhdV6Db1q4Ons7Be7QhtnqiXtRYMh/MHJfNViPvry
+xS3T/dRlAgMBAAGjgZ8wgZwwEwYJKwYBBAGCNxQCBAYeBABDAEEwCwYDVR0PBAQDAgGGMA8GA1Ud
+EwEB/wQFMAMBAf8wHQYDVR0OBBYEFMZPoj0GY4QJnM5i5ASsjVy16bYbMDYGA1UdHwQvMC0wK6Ap
+oCeGJWh0dHA6Ly9jcmwueHJhbXBzZWN1cml0eS5jb20vWEdDQS5jcmwwEAYJKwYBBAGCNxUBBAMC
+AQEwDQYJKoZIhvcNAQEFBQADggEBAJEVOQMBG2f7Shz5CmBbodpNl2L5JFMn14JkTpAuw0kbK5rc
+/Kh4ZzXxHfARvbdI4xD2Dd8/0sm2qlWkSLoC295ZLhVbO50WfUfXN+pfTXYSNrsf16GBBEYgoyxt
+qZ4Bfj8pzgCT3/3JknOJiWSe5yvkHJEs0rnOfc5vMZnT5r7SHpDwCRR5XCOrTdLaIR9NmXmd4c8n
+nxCbHIgNsIpkQTG4DmyQJKSbXHGPurt+HBvbaoAPIbzp26a3QPSyi6mx5O+aGtA9aZnuqCij4Tyz
+8LIRnM98QObd50N9otg6tamN8jSZxNQQ4Qb9CYQQO+7ETPTsJ3xCwnR8gooJybQDJbw=
+-----END CERTIFICATE-----
+
+Go Daddy Class 2 CA
+===================
+-----BEGIN CERTIFICATE-----
+MIIEADCCAuigAwIBAgIBADANBgkqhkiG9w0BAQUFADBjMQswCQYDVQQGEwJVUzEhMB8GA1UEChMY
+VGhlIEdvIERhZGR5IEdyb3VwLCBJbmMuMTEwLwYDVQQLEyhHbyBEYWRkeSBDbGFzcyAyIENlcnRp
+ZmljYXRpb24gQXV0aG9yaXR5MB4XDTA0MDYyOTE3MDYyMFoXDTM0MDYyOTE3MDYyMFowYzELMAkG
+A1UEBhMCVVMxITAfBgNVBAoTGFRoZSBHbyBEYWRkeSBHcm91cCwgSW5jLjExMC8GA1UECxMoR28g
+RGFkZHkgQ2xhc3MgMiBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTCCASAwDQYJKoZIhvcNAQEBBQAD
+ggENADCCAQgCggEBAN6d1+pXGEmhW+vXX0iG6r7d/+TvZxz0ZWizV3GgXne77ZtJ6XCAPVYYYwhv
+2vLM0D9/AlQiVBDYsoHUwHU9S3/Hd8M+eKsaA7Ugay9qK7HFiH7Eux6wwdhFJ2+qN1j3hybX2C32
+qRe3H3I2TqYXP2WYktsqbl2i/ojgC95/5Y0V4evLOtXiEqITLdiOr18SPaAIBQi2XKVlOARFmR6j
+YGB0xUGlcmIbYsUfb18aQr4CUWWoriMYavx4A6lNf4DD+qta/KFApMoZFv6yyO9ecw3ud72a9nmY
+vLEHZ6IVDd2gWMZEewo+YihfukEHU1jPEX44dMX4/7VpkI+EdOqXG68CAQOjgcAwgb0wHQYDVR0O
+BBYEFNLEsNKR1EwRcbNhyz2h/t2oatTjMIGNBgNVHSMEgYUwgYKAFNLEsNKR1EwRcbNhyz2h/t2o
+atTjoWekZTBjMQswCQYDVQQGEwJVUzEhMB8GA1UEChMYVGhlIEdvIERhZGR5IEdyb3VwLCBJbmMu
+MTEwLwYDVQQLEyhHbyBEYWRkeSBDbGFzcyAyIENlcnRpZmljYXRpb24gQXV0aG9yaXR5ggEAMAwG
+A1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADggEBADJL87LKPpH8EsahB4yOd6AzBhRckB4Y9wim
+PQoZ+YeAEW5p5JYXMP80kWNyOO7MHAGjHZQopDH2esRU1/blMVgDoszOYtuURXO1v0XJJLXVggKt
+I3lpjbi2Tc7PTMozI+gciKqdi0FuFskg5YmezTvacPd+mSYgFFQlq25zheabIZ0KbIIOqPjCDPoQ
+HmyW74cNxA9hi63ugyuV+I6ShHI56yDqg+2DzZduCLzrTia2cyvk0/ZM/iZx4mERdEr/VxqHD3VI
+Ls9RaRegAhJhldXRQLIQTO7ErBBDpqWeCtWVYpoNz4iCxTIM5CufReYNnyicsbkqWletNw+vHX/b
+vZ8=
+-----END CERTIFICATE-----
+
+Starfield Class 2 CA
+====================
+-----BEGIN CERTIFICATE-----
+MIIEDzCCAvegAwIBAgIBADANBgkqhkiG9w0BAQUFADBoMQswCQYDVQQGEwJVUzElMCMGA1UEChMc
+U3RhcmZpZWxkIFRlY2hub2xvZ2llcywgSW5jLjEyMDAGA1UECxMpU3RhcmZpZWxkIENsYXNzIDIg
+Q2VydGlmaWNhdGlvbiBBdXRob3JpdHkwHhcNMDQwNjI5MTczOTE2WhcNMzQwNjI5MTczOTE2WjBo
+MQswCQYDVQQGEwJVUzElMCMGA1UEChMcU3RhcmZpZWxkIFRlY2hub2xvZ2llcywgSW5jLjEyMDAG
+A1UECxMpU3RhcmZpZWxkIENsYXNzIDIgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkwggEgMA0GCSqG
+SIb3DQEBAQUAA4IBDQAwggEIAoIBAQC3Msj+6XGmBIWtDBFk385N78gDGIc/oav7PKaf8MOh2tTY
+bitTkPskpD6E8J7oX+zlJ0T1KKY/e97gKvDIr1MvnsoFAZMej2YcOadN+lq2cwQlZut3f+dZxkqZ
+JRRU6ybH838Z1TBwj6+wRir/resp7defqgSHo9T5iaU0X9tDkYI22WY8sbi5gv2cOj4QyDvvBmVm
+epsZGD3/cVE8MC5fvj13c7JdBmzDI1aaK4UmkhynArPkPw2vCHmCuDY96pzTNbO8acr1zJ3o/WSN
+F4Azbl5KXZnJHoe0nRrA1W4TNSNe35tfPe/W93bC6j67eA0cQmdrBNj41tpvi/JEoAGrAgEDo4HF
+MIHCMB0GA1UdDgQWBBS/X7fRzt0fhvRbVazc1xDCDqmI5zCBkgYDVR0jBIGKMIGHgBS/X7fRzt0f
+hvRbVazc1xDCDqmI56FspGowaDELMAkGA1UEBhMCVVMxJTAjBgNVBAoTHFN0YXJmaWVsZCBUZWNo
+bm9sb2dpZXMsIEluYy4xMjAwBgNVBAsTKVN0YXJmaWVsZCBDbGFzcyAyIENlcnRpZmljYXRpb24g
+QXV0aG9yaXR5ggEAMAwGA1UdEwQFMAMBAf8wDQYJKoZIhvcNAQEFBQADggEBAAWdP4id0ckaVaGs
+afPzWdqbAYcaT1epoXkJKtv3L7IezMdeatiDh6GX70k1PncGQVhiv45YuApnP+yz3SFmH8lU+nLM
+PUxA2IGvd56Deruix/U0F47ZEUD0/CwqTRV/p2JdLiXTAAsgGh1o+Re49L2L7ShZ3U0WixeDyLJl
+xy16paq8U4Zt3VekyvggQQto8PT7dL5WXXp59fkdheMtlb71cZBDzI0fmgAKhynpVSJYACPq4xJD
+KVtHCN2MQWplBqjlIapBtJUhlbl90TSrE9atvNziPTnNvT51cKEYWQPJIrSPnNVeKtelttQKbfi3
+QBFGmh95DmK/D5fs4C8fF5Q=
+-----END CERTIFICATE-----
+
+Taiwan GRCA
+===========
+-----BEGIN CERTIFICATE-----
+MIIFcjCCA1qgAwIBAgIQH51ZWtcvwgZEpYAIaeNe9jANBgkqhkiG9w0BAQUFADA/MQswCQYDVQQG
+EwJUVzEwMC4GA1UECgwnR292ZXJubWVudCBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5MB4X
+DTAyMTIwNTEzMjMzM1oXDTMyMTIwNTEzMjMzM1owPzELMAkGA1UEBhMCVFcxMDAuBgNVBAoMJ0dv
+dmVybm1lbnQgUm9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTCCAiIwDQYJKoZIhvcNAQEBBQAD
+ggIPADCCAgoCggIBAJoluOzMonWoe/fOW1mKydGGEghU7Jzy50b2iPN86aXfTEc2pBsBHH8eV4qN
+w8XRIePaJD9IK/ufLqGU5ywck9G/GwGHU5nOp/UKIXZ3/6m3xnOUT0b3EEk3+qhZSV1qgQdW8or5
+BtD3cCJNtLdBuTK4sfCxw5w/cP1T3YGq2GN49thTbqGsaoQkclSGxtKyyhwOeYHWtXBiCAEuTk8O
+1RGvqa/lmr/czIdtJuTJV6L7lvnM4T9TjGxMfptTCAtsF/tnyMKtsc2AtJfcdgEWFelq16TheEfO
+htX7MfP6Mb40qij7cEwdScevLJ1tZqa2jWR+tSBqnTuBto9AAGdLiYa4zGX+FVPpBMHWXx1E1wov
+J5pGfaENda1UhhXcSTvxls4Pm6Dso3pdvtUqdULle96ltqqvKKyskKw4t9VoNSZ63Pc78/1Fm9G7
+Q3hub/FCVGqY8A2tl+lSXunVanLeavcbYBT0peS2cWeqH+riTcFCQP5nRhc4L0c/cZyu5SHKYS1t
+B6iEfC3uUSXxY5Ce/eFXiGvviiNtsea9P63RPZYLhY3Naye7twWb7LuRqQoHEgKXTiCQ8P8NHuJB
+O9NAOueNXdpm5AKwB1KYXA6OM5zCppX7VRluTI6uSw+9wThNXo+EHWbNxWCWtFJaBYmOlXqYwZE8
+lSOyDvR5tMl8wUohAgMBAAGjajBoMB0GA1UdDgQWBBTMzO/MKWCkO7GStjz6MmKPrCUVOzAMBgNV
+HRMEBTADAQH/MDkGBGcqBwAEMTAvMC0CAQAwCQYFKw4DAhoFADAHBgVnKgMAAAQUA5vwIhP/lSg2
+09yewDL7MTqKUWUwDQYJKoZIhvcNAQEFBQADggIBAECASvomyc5eMN1PhnR2WPWus4MzeKR6dBcZ
+TulStbngCnRiqmjKeKBMmo4sIy7VahIkv9Ro04rQ2JyftB8M3jh+Vzj8jeJPXgyfqzvS/3WXy6Tj
+Zwj/5cAWtUgBfen5Cv8b5Wppv3ghqMKnI6mGq3ZW6A4M9hPdKmaKZEk9GhiHkASfQlK3T8v+R0F2
+Ne//AHY2RTKbxkaFXeIksB7jSJaYV0eUVXoPQbFEJPPB/hprv4j9wabak2BegUqZIJxIZhm1AHlU
+D7gsL0u8qV1bYH+Mh6XgUmMqvtg7hUAV/h62ZT/FS9p+tXo1KaMuephgIqP0fSdOLeq0dDzpD6Qz
+DxARvBMB1uUO07+1EqLhRSPAzAhuYbeJq4PjJB7mXQfnHyA+z2fI56wwbSdLaG5LKlwCCDTb+Hbk
+Z6MmnD+iMsJKxYEYMRBWqoTvLQr/uB930r+lWKBi5NdLkXWNiYCYfm3LU05er/ayl4WXudpVBrkk
+7tfGOB5jGxI7leFYrPLfhNVfmS8NVVvmONsuP3LpSIXLuykTjx44VbnzssQwmSNOXfJIoRIM3BKQ
+CZBUkQM8R+XVyWXgt0t97EfTsws+rZ7QdAAO671RrcDeLMDDav7v3Aun+kbfYNucpllQdSNpc5Oy
++fwC00fmcc4QAu4njIT/rEUNE1yDMuAlpYYsfPQS
+-----END CERTIFICATE-----
+
+DigiCert Assured ID Root CA
+===========================
+-----BEGIN CERTIFICATE-----
+MIIDtzCCAp+gAwIBAgIQDOfg5RfYRv6P5WD8G/AwOTANBgkqhkiG9w0BAQUFADBlMQswCQYDVQQG
+EwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3d3cuZGlnaWNlcnQuY29tMSQw
+IgYDVQQDExtEaWdpQ2VydCBBc3N1cmVkIElEIFJvb3QgQ0EwHhcNMDYxMTEwMDAwMDAwWhcNMzEx
+MTEwMDAwMDAwWjBlMQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQL
+ExB3d3cuZGlnaWNlcnQuY29tMSQwIgYDVQQDExtEaWdpQ2VydCBBc3N1cmVkIElEIFJvb3QgQ0Ew
+ggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCtDhXO5EOAXLGH87dg+XESpa7cJpSIqvTO
+9SA5KFhgDPiA2qkVlTJhPLWxKISKityfCgyDF3qPkKyK53lTXDGEKvYPmDI2dsze3Tyoou9q+yHy
+UmHfnyDXH+Kx2f4YZNISW1/5WBg1vEfNoTb5a3/UsDg+wRvDjDPZ2C8Y/igPs6eD1sNuRMBhNZYW
+/lmci3Zt1/GiSw0r/wty2p5g0I6QNcZ4VYcgoc/lbQrISXwxmDNsIumH0DJaoroTghHtORedmTpy
+oeb6pNnVFzF1roV9Iq4/AUaG9ih5yLHa5FcXxH4cDrC0kqZWs72yl+2qp/C3xag/lRbQ/6GW6whf
+GHdPAgMBAAGjYzBhMA4GA1UdDwEB/wQEAwIBhjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBRF
+66Kv9JLLgjEtUYunpyGd823IDzAfBgNVHSMEGDAWgBRF66Kv9JLLgjEtUYunpyGd823IDzANBgkq
+hkiG9w0BAQUFAAOCAQEAog683+Lt8ONyc3pklL/3cmbYMuRCdWKuh+vy1dneVrOfzM4UKLkNl2Bc
+EkxY5NM9g0lFWJc1aRqoR+pWxnmrEthngYTffwk8lOa4JiwgvT2zKIn3X/8i4peEH+ll74fg38Fn
+SbNd67IJKusm7Xi+fT8r87cmNW1fiQG2SVufAQWbqz0lwcy2f8Lxb4bG+mRo64EtlOtCt/qMHt1i
+8b5QZ7dsvfPxH2sMNgcWfzd8qVttevESRmCD1ycEvkvOl77DZypoEd+A5wwzZr8TDRRu838fYxAe
++o0bJW1sj6W3YQGx0qMmoRBxna3iw/nDmVG3KwcIzi7mULKn+gpFL6Lw8g==
+-----END CERTIFICATE-----
+
+DigiCert Global Root CA
+=======================
+-----BEGIN CERTIFICATE-----
+MIIDrzCCApegAwIBAgIQCDvgVpBCRrGhdWrJWZHHSjANBgkqhkiG9w0BAQUFADBhMQswCQYDVQQG
+EwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3d3cuZGlnaWNlcnQuY29tMSAw
+HgYDVQQDExdEaWdpQ2VydCBHbG9iYWwgUm9vdCBDQTAeFw0wNjExMTAwMDAwMDBaFw0zMTExMTAw
+MDAwMDBaMGExCzAJBgNVBAYTAlVTMRUwEwYDVQQKEwxEaWdpQ2VydCBJbmMxGTAXBgNVBAsTEHd3
+dy5kaWdpY2VydC5jb20xIDAeBgNVBAMTF0RpZ2lDZXJ0IEdsb2JhbCBSb290IENBMIIBIjANBgkq
+hkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA4jvhEXLeqKTTo1eqUKKPC3eQyaKl7hLOllsBCSDMAZOn
+TjC3U/dDxGkAV53ijSLdhwZAAIEJzs4bg7/fzTtxRuLWZscFs3YnFo97nh6Vfe63SKMI2tavegw5
+BmV/Sl0fvBf4q77uKNd0f3p4mVmFaG5cIzJLv07A6Fpt43C/dxC//AH2hdmoRBBYMql1GNXRor5H
+4idq9Joz+EkIYIvUX7Q6hL+hqkpMfT7PT19sdl6gSzeRntwi5m3OFBqOasv+zbMUZBfHWymeMr/y
+7vrTC0LUq7dBMtoM1O/4gdW7jVg/tRvoSSiicNoxBN33shbyTApOB6jtSj1etX+jkMOvJwIDAQAB
+o2MwYTAOBgNVHQ8BAf8EBAMCAYYwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQUA95QNVbRTLtm
+8KPiGxvDl7I90VUwHwYDVR0jBBgwFoAUA95QNVbRTLtm8KPiGxvDl7I90VUwDQYJKoZIhvcNAQEF
+BQADggEBAMucN6pIExIK+t1EnE9SsPTfrgT1eXkIoyQY/EsrhMAtudXH/vTBH1jLuG2cenTnmCmr
+EbXjcKChzUyImZOMkXDiqw8cvpOp/2PV5Adg06O/nVsJ8dWO41P0jmP6P6fbtGbfYmbW0W5BjfIt
+tep3Sp+dWOIrWcBAI+0tKIJFPnlUkiaY4IBIqDfv8NZ5YBberOgOzW6sRBc4L0na4UU+Krk2U886
+UAb3LujEV0lsYSEY1QSteDwsOoBrp+uvFRTp2InBuThs4pFsiv9kuXclVzDAGySj4dzp30d8tbQk
+CAUw7C29C79Fv1C5qfPrmAESrciIxpg0X40KPMbp1ZWVbd4=
+-----END CERTIFICATE-----
+
+DigiCert High Assurance EV Root CA
+==================================
+-----BEGIN CERTIFICATE-----
+MIIDxTCCAq2gAwIBAgIQAqxcJmoLQJuPC3nyrkYldzANBgkqhkiG9w0BAQUFADBsMQswCQYDVQQG
+EwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3d3cuZGlnaWNlcnQuY29tMSsw
+KQYDVQQDEyJEaWdpQ2VydCBIaWdoIEFzc3VyYW5jZSBFViBSb290IENBMB4XDTA2MTExMDAwMDAw
+MFoXDTMxMTExMDAwMDAwMFowbDELMAkGA1UEBhMCVVMxFTATBgNVBAoTDERpZ2lDZXJ0IEluYzEZ
+MBcGA1UECxMQd3d3LmRpZ2ljZXJ0LmNvbTErMCkGA1UEAxMiRGlnaUNlcnQgSGlnaCBBc3N1cmFu
+Y2UgRVYgUm9vdCBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMbM5XPm+9S75S0t
+Mqbf5YE/yc0lSbZxKsPVlDRnogocsF9ppkCxxLeyj9CYpKlBWTrT3JTWPNt0OKRKzE0lgvdKpVMS
+OO7zSW1xkX5jtqumX8OkhPhPYlG++MXs2ziS4wblCJEMxChBVfvLWokVfnHoNb9Ncgk9vjo4UFt3
+MRuNs8ckRZqnrG0AFFoEt7oT61EKmEFBIk5lYYeBQVCmeVyJ3hlKV9Uu5l0cUyx+mM0aBhakaHPQ
+NAQTXKFx01p8VdteZOE3hzBWBOURtCmAEvF5OYiiAhF8J2a3iLd48soKqDirCmTCv2ZdlYTBoSUe
+h10aUAsgEsxBu24LUTi4S8sCAwEAAaNjMGEwDgYDVR0PAQH/BAQDAgGGMA8GA1UdEwEB/wQFMAMB
+Af8wHQYDVR0OBBYEFLE+w2kD+L9HAdSYJhoIAu9jZCvDMB8GA1UdIwQYMBaAFLE+w2kD+L9HAdSY
+JhoIAu9jZCvDMA0GCSqGSIb3DQEBBQUAA4IBAQAcGgaX3NecnzyIZgYIVyHbIUf4KmeqvxgydkAQ
+V8GK83rZEWWONfqe/EW1ntlMMUu4kehDLI6zeM7b41N5cdblIZQB2lWHmiRk9opmzN6cN82oNLFp
+myPInngiK3BD41VHMWEZ71jFhS9OMPagMRYjyOfiZRYzy78aG6A9+MpeizGLYAiJLQwGXFK3xPkK
+mNEVX58Svnw2Yzi9RKR/5CYrCsSXaQ3pjOLAEFe4yHYSkVXySGnYvCoCWw9E1CAx2/S6cCZdkGCe
+vEsXCS+0yx5DaMkHJ8HSXPfqIbloEpw8nL+e/IBcm2PN7EeqJSdnoDfzAIJ9VNep+OkuE6N36B9K
+-----END CERTIFICATE-----
+
+Certplus Class 2 Primary CA
+===========================
+-----BEGIN CERTIFICATE-----
+MIIDkjCCAnqgAwIBAgIRAIW9S/PY2uNp9pTXX8OlRCMwDQYJKoZIhvcNAQEFBQAwPTELMAkGA1UE
+BhMCRlIxETAPBgNVBAoTCENlcnRwbHVzMRswGQYDVQQDExJDbGFzcyAyIFByaW1hcnkgQ0EwHhcN
+OTkwNzA3MTcwNTAwWhcNMTkwNzA2MjM1OTU5WjA9MQswCQYDVQQGEwJGUjERMA8GA1UEChMIQ2Vy
+dHBsdXMxGzAZBgNVBAMTEkNsYXNzIDIgUHJpbWFyeSBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEP
+ADCCAQoCggEBANxQltAS+DXSCHh6tlJw/W/uz7kRy1134ezpfgSN1sxvc0NXYKwzCkTsA18cgCSR
+5aiRVhKC9+Ar9NuuYS6JEI1rbLqzAr3VNsVINyPi8Fo3UjMXEuLRYE2+L0ER4/YXJQyLkcAbmXuZ
+Vg2v7tK8R1fjeUl7NIknJITesezpWE7+Tt9avkGtrAjFGA7v0lPubNCdEgETjdyAYveVqUSISnFO
+YFWe2yMZeVYHDD9jC1yw4r5+FfyUM1hBOHTE4Y+L3yasH7WLO7dDWWuwJKZtkIvEcupdM5i3y95e
+e++U8Rs+yskhwcWYAqqi9lt3m/V+llU0HGdpwPFC40es/CgcZlUCAwEAAaOBjDCBiTAPBgNVHRME
+CDAGAQH/AgEKMAsGA1UdDwQEAwIBBjAdBgNVHQ4EFgQU43Mt38sOKAze3bOkynm4jrvoMIkwEQYJ
+YIZIAYb4QgEBBAQDAgEGMDcGA1UdHwQwMC4wLKAqoCiGJmh0dHA6Ly93d3cuY2VydHBsdXMuY29t
+L0NSTC9jbGFzczIuY3JsMA0GCSqGSIb3DQEBBQUAA4IBAQCnVM+IRBnL39R/AN9WM2K191EBkOvD
+P9GIROkkXe/nFL0gt5o8AP5tn9uQ3Nf0YtaLcF3n5QRIqWh8yfFC82x/xXp8HVGIutIKPidd3i1R
+TtMTZGnkLuPT55sJmabglZvOGtd/vjzOUrMRFcEPF80Du5wlFbqidon8BvEY0JNLDnyCt6X09l/+
+7UCmnYR0ObncHoUW2ikbhiMAybuJfm6AiB4vFLQDJKgybwOaRywwvlbGp0ICcBvqQNi6BQNwB6SW
+//1IMwrh3KWBkJtN3X3n57LNXMhqlfil9o3EXXgIvnsG1knPGTZQIy4I5p4FTUcY1Rbpsda2ENW7
+l7+ijrRU
+-----END CERTIFICATE-----
+
+DST Root CA X3
+==============
+-----BEGIN CERTIFICATE-----
+MIIDSjCCAjKgAwIBAgIQRK+wgNajJ7qJMDmGLvhAazANBgkqhkiG9w0BAQUFADA/MSQwIgYDVQQK
+ExtEaWdpdGFsIFNpZ25hdHVyZSBUcnVzdCBDby4xFzAVBgNVBAMTDkRTVCBSb290IENBIFgzMB4X
+DTAwMDkzMDIxMTIxOVoXDTIxMDkzMDE0MDExNVowPzEkMCIGA1UEChMbRGlnaXRhbCBTaWduYXR1
+cmUgVHJ1c3QgQ28uMRcwFQYDVQQDEw5EU1QgUm9vdCBDQSBYMzCCASIwDQYJKoZIhvcNAQEBBQAD
+ggEPADCCAQoCggEBAN+v6ZdQCINXtMxiZfaQguzH0yxrMMpb7NnDfcdAwRgUi+DoM3ZJKuM/IUmT
+rE4Orz5Iy2Xu/NMhD2XSKtkyj4zl93ewEnu1lcCJo6m67XMuegwGMoOifooUMM0RoOEqOLl5CjH9
+UL2AZd+3UWODyOKIYepLYYHsUmu5ouJLGiifSKOeDNoJjj4XLh7dIN9bxiqKqy69cK3FCxolkHRy
+xXtqqzTWMIn/5WgTe1QLyNau7Fqckh49ZLOMxt+/yUFw7BZy1SbsOFU5Q9D8/RhcQPGX69Wam40d
+utolucbY38EVAjqr2m7xPi71XAicPNaDaeQQmxkqtilX4+U9m5/wAl0CAwEAAaNCMEAwDwYDVR0T
+AQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0OBBYEFMSnsaR7LHH62+FLkHX/xBVghYkQ
+MA0GCSqGSIb3DQEBBQUAA4IBAQCjGiybFwBcqR7uKGY3Or+Dxz9LwwmglSBd49lZRNI+DT69ikug
+dB/OEIKcdBodfpga3csTS7MgROSR6cz8faXbauX+5v3gTt23ADq1cEmv8uXrAvHRAosZy5Q6XkjE
+GB5YGV8eAlrwDPGxrancWYaLbumR9YbK+rlmM6pZW87ipxZzR8srzJmwN0jP41ZL9c8PDHIyh8bw
+RLtTcm1D9SZImlJnt1ir/md2cXjbDaJWFBM5JDGFoqgCWjBH4d1QB7wCCZAA62RjYJsWvIjJEubS
+fZGL+T0yjWW06XyxV3bqxbYoOb8VZRzI9neWagqNdwvYkQsEjgfbKbYK7p2CNTUQ
+-----END CERTIFICATE-----
+
+DST ACES CA X6
+==============
+-----BEGIN CERTIFICATE-----
+MIIECTCCAvGgAwIBAgIQDV6ZCtadt3js2AdWO4YV2TANBgkqhkiG9w0BAQUFADBbMQswCQYDVQQG
+EwJVUzEgMB4GA1UEChMXRGlnaXRhbCBTaWduYXR1cmUgVHJ1c3QxETAPBgNVBAsTCERTVCBBQ0VT
+MRcwFQYDVQQDEw5EU1QgQUNFUyBDQSBYNjAeFw0wMzExMjAyMTE5NThaFw0xNzExMjAyMTE5NTha
+MFsxCzAJBgNVBAYTAlVTMSAwHgYDVQQKExdEaWdpdGFsIFNpZ25hdHVyZSBUcnVzdDERMA8GA1UE
+CxMIRFNUIEFDRVMxFzAVBgNVBAMTDkRTVCBBQ0VTIENBIFg2MIIBIjANBgkqhkiG9w0BAQEFAAOC
+AQ8AMIIBCgKCAQEAuT31LMmU3HWKlV1j6IR3dma5WZFcRt2SPp/5DgO0PWGSvSMmtWPuktKe1jzI
+DZBfZIGxqAgNTNj50wUoUrQBJcWVHAx+PhCEdc/BGZFjz+iokYi5Q1K7gLFViYsx+tC3dr5BPTCa
+pCIlF3PoHuLTrCq9Wzgh1SpL11V94zpVvddtawJXa+ZHfAjIgrrep4c9oW24MFbCswKBXy314pow
+GCi4ZtPLAZZv6opFVdbgnf9nKxcCpk4aahELfrd755jWjHZvwTvbUJN+5dCOHze4vbrGn2zpfDPy
+MjwmR/onJALJfh1biEITajV8fTXpLmaRcpPVMibEdPVTo7NdmvYJywIDAQABo4HIMIHFMA8GA1Ud
+EwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgHGMB8GA1UdEQQYMBaBFHBraS1vcHNAdHJ1c3Rkc3Qu
+Y29tMGIGA1UdIARbMFkwVwYKYIZIAWUDAgEBATBJMEcGCCsGAQUFBwIBFjtodHRwOi8vd3d3LnRy
+dXN0ZHN0LmNvbS9jZXJ0aWZpY2F0ZXMvcG9saWN5L0FDRVMtaW5kZXguaHRtbDAdBgNVHQ4EFgQU
+CXIGThhDD+XWzMNqizF7eI+og7gwDQYJKoZIhvcNAQEFBQADggEBAKPYjtay284F5zLNAdMEA+V2
+5FYrnJmQ6AgwbN99Pe7lv7UkQIRJ4dEorsTCOlMwiPH1d25Ryvr/ma8kXxug/fKshMrfqfBfBC6t
+Fr8hlxCBPeP/h40y3JTlR4peahPJlJU90u7INJXQgNStMgiAVDzgvVJT11J8smk/f3rPanTK+gQq
+nExaBqXpIK1FZg9p8d2/6eMyi/rgwYZNcjwu2JN4Cir42NInPRmJX1p7ijvMDNpRrscL9yuwNwXs
+vFcj4jjSm2jzVhKIT0J8uDHEtdvkyCE06UgRNe76x5JXxZ805Mf29w4LTJxoeHtxMcfrHuBnQfO3
+oKfN5XozNmr6mis=
+-----END CERTIFICATE-----
+
+SwissSign Gold CA - G2
+======================
+-----BEGIN CERTIFICATE-----
+MIIFujCCA6KgAwIBAgIJALtAHEP1Xk+wMA0GCSqGSIb3DQEBBQUAMEUxCzAJBgNVBAYTAkNIMRUw
+EwYDVQQKEwxTd2lzc1NpZ24gQUcxHzAdBgNVBAMTFlN3aXNzU2lnbiBHb2xkIENBIC0gRzIwHhcN
+MDYxMDI1MDgzMDM1WhcNMzYxMDI1MDgzMDM1WjBFMQswCQYDVQQGEwJDSDEVMBMGA1UEChMMU3dp
+c3NTaWduIEFHMR8wHQYDVQQDExZTd2lzc1NpZ24gR29sZCBDQSAtIEcyMIICIjANBgkqhkiG9w0B
+AQEFAAOCAg8AMIICCgKCAgEAr+TufoskDhJuqVAtFkQ7kpJcyrhdhJJCEyq8ZVeCQD5XJM1QiyUq
+t2/876LQwB8CJEoTlo8jE+YoWACjR8cGp4QjK7u9lit/VcyLwVcfDmJlD909Vopz2q5+bbqBHH5C
+jCA12UNNhPqE21Is8w4ndwtrvxEvcnifLtg+5hg3Wipy+dpikJKVyh+c6bM8K8vzARO/Ws/BtQpg
+vd21mWRTuKCWs2/iJneRjOBiEAKfNA+k1ZIzUd6+jbqEemA8atufK+ze3gE/bk3lUIbLtK/tREDF
+ylqM2tIrfKjuvqblCqoOpd8FUrdVxyJdMmqXl2MT28nbeTZ7hTpKxVKJ+STnnXepgv9VHKVxaSvR
+AiTysybUa9oEVeXBCsdtMDeQKuSeFDNeFhdVxVu1yzSJkvGdJo+hB9TGsnhQ2wwMC3wLjEHXuend
+jIj3o02yMszYF9rNt85mndT9Xv+9lz4pded+p2JYryU0pUHHPbwNUMoDAw8IWh+Vc3hiv69yFGkO
+peUDDniOJihC8AcLYiAQZzlG+qkDzAQ4embvIIO1jEpWjpEA/I5cgt6IoMPiaG59je883WX0XaxR
+7ySArqpWl2/5rX3aYT+YdzylkbYcjCbaZaIJbcHiVOO5ykxMgI93e2CaHt+28kgeDrpOVG2Y4OGi
+GqJ3UM/EY5LsRxmd6+ZrzsECAwEAAaOBrDCBqTAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUw
+AwEB/zAdBgNVHQ4EFgQUWyV7lqRlUX64OfPAeGZe6Drn8O4wHwYDVR0jBBgwFoAUWyV7lqRlUX64
+OfPAeGZe6Drn8O4wRgYDVR0gBD8wPTA7BglghXQBWQECAQEwLjAsBggrBgEFBQcCARYgaHR0cDov
+L3JlcG9zaXRvcnkuc3dpc3NzaWduLmNvbS8wDQYJKoZIhvcNAQEFBQADggIBACe645R88a7A3hfm
+5djV9VSwg/S7zV4Fe0+fdWavPOhWfvxyeDgD2StiGwC5+OlgzczOUYrHUDFu4Up+GC9pWbY9ZIEr
+44OE5iKHjn3g7gKZYbge9LgriBIWhMIxkziWMaa5O1M/wySTVltpkuzFwbs4AOPsF6m43Md8AYOf
+Mke6UiI0HTJ6CVanfCU2qT1L2sCCbwq7EsiHSycR+R4tx5M/nttfJmtS2S6K8RTGRI0Vqbe/vd6m
+Gu6uLftIdxf+u+yvGPUqUfA5hJeVbG4bwyvEdGB5JbAKJ9/fXtI5z0V9QkvfsywexcZdylU6oJxp
+mo/a77KwPJ+HbBIrZXAVUjEaJM9vMSNQH4xPjyPDdEFjHFWoFN0+4FFQz/EbMFYOkrCChdiDyyJk
+vC24JdVUorgG6q2SpCSgwYa1ShNqR88uC1aVVMvOmttqtKay20EIhid392qgQmwLOM7XdVAyksLf
+KzAiSNDVQTglXaTpXZ/GlHXQRf0wl0OPkKsKx4ZzYEppLd6leNcG2mqeSz53OiATIgHQv2ieY2Br
+NU0LbbqhPcCT4H8js1WtciVORvnSFu+wZMEBnunKoGqYDs/YYPIvSbjkQuE4NRb0yG5P94FW6Lqj
+viOvrv1vA+ACOzB2+httQc8Bsem4yWb02ybzOqR08kkkW8mw0FfB+j564ZfJ
+-----END CERTIFICATE-----
+
+SwissSign Silver CA - G2
+========================
+-----BEGIN CERTIFICATE-----
+MIIFvTCCA6WgAwIBAgIITxvUL1S7L0swDQYJKoZIhvcNAQEFBQAwRzELMAkGA1UEBhMCQ0gxFTAT
+BgNVBAoTDFN3aXNzU2lnbiBBRzEhMB8GA1UEAxMYU3dpc3NTaWduIFNpbHZlciBDQSAtIEcyMB4X
+DTA2MTAyNTA4MzI0NloXDTM2MTAyNTA4MzI0NlowRzELMAkGA1UEBhMCQ0gxFTATBgNVBAoTDFN3
+aXNzU2lnbiBBRzEhMB8GA1UEAxMYU3dpc3NTaWduIFNpbHZlciBDQSAtIEcyMIICIjANBgkqhkiG
+9w0BAQEFAAOCAg8AMIICCgKCAgEAxPGHf9N4Mfc4yfjDmUO8x/e8N+dOcbpLj6VzHVxumK4DV644
+N0MvFz0fyM5oEMF4rhkDKxD6LHmD9ui5aLlV8gREpzn5/ASLHvGiTSf5YXu6t+WiE7brYT7QbNHm
++/pe7R20nqA1W6GSy/BJkv6FCgU+5tkL4k+73JU3/JHpMjUi0R86TieFnbAVlDLaYQ1HTWBCrpJH
+6INaUFjpiou5XaHc3ZlKHzZnu0jkg7Y360g6rw9njxcH6ATK72oxh9TAtvmUcXtnZLi2kUpCe2Uu
+MGoM9ZDulebyzYLs2aFK7PayS+VFheZteJMELpyCbTapxDFkH4aDCyr0NQp4yVXPQbBH6TCfmb5h
+qAaEuSh6XzjZG6k4sIN/c8HDO0gqgg8hm7jMqDXDhBuDsz6+pJVpATqJAHgE2cn0mRmrVn5bi4Y5
+FZGkECwJMoBgs5PAKrYYC51+jUnyEEp/+dVGLxmSo5mnJqy7jDzmDrxHB9xzUfFwZC8I+bRHHTBs
+ROopN4WSaGa8gzj+ezku01DwH/teYLappvonQfGbGHLy9YR0SslnxFSuSGTfjNFusB3hB48IHpmc
+celM2KX3RxIfdNFRnobzwqIjQAtz20um53MGjMGg6cFZrEb65i/4z3GcRm25xBWNOHkDRUjvxF3X
+CO6HOSKGsg0PWEP3calILv3q1h8CAwEAAaOBrDCBqTAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/
+BAUwAwEB/zAdBgNVHQ4EFgQUF6DNweRBtjpbO8tFnb0cwpj6hlgwHwYDVR0jBBgwFoAUF6DNweRB
+tjpbO8tFnb0cwpj6hlgwRgYDVR0gBD8wPTA7BglghXQBWQEDAQEwLjAsBggrBgEFBQcCARYgaHR0
+cDovL3JlcG9zaXRvcnkuc3dpc3NzaWduLmNvbS8wDQYJKoZIhvcNAQEFBQADggIBAHPGgeAn0i0P
+4JUw4ppBf1AsX19iYamGamkYDHRJ1l2E6kFSGG9YrVBWIGrGvShpWJHckRE1qTodvBqlYJ7YH39F
+kWnZfrt4csEGDyrOj4VwYaygzQu4OSlWhDJOhrs9xCrZ1x9y7v5RoSJBsXECYxqCsGKrXlcSH9/L
+3XWgwF15kIwb4FDm3jH+mHtwX6WQ2K34ArZv02DdQEsixT2tOnqfGhpHkXkzuoLcMmkDlm4fS/Bx
+/uNncqCxv1yL5PqZIseEuRuNI5c/7SXgz2W79WEE790eslpBIlqhn10s6FvJbakMDHiqYMZWjwFa
+DGi8aRl5xB9+lwW/xekkUV7U1UtT7dkjWjYDZaPBA61BMPNGG4WQr2W11bHkFlt4dR2Xem1ZqSqP
+e97Dh4kQmUlzeMg9vVE1dCrV8X5pGyq7O70luJpaPXJhkGaH7gzWTdQRdAtq/gsD/KNVV4n+Ssuu
+WxcFyPKNIzFTONItaj+CuY0IavdeQXRuwxF+B6wpYJE/OMpXEA29MC/HpeZBoNquBYeaoKRlbEwJ
+DIm6uNO5wJOKMPqN5ZprFQFOZ6raYlY+hAhm0sQ2fac+EPyI4NSA5QC9qvNOBqN6avlicuMJT+ub
+DgEj8Z+7fNzcbBGXJbLytGMU0gYqZ4yD9c7qB9iaah7s5Aq7KkzrCWA5zspi2C5u
+-----END CERTIFICATE-----
+
+GeoTrust Primary Certification Authority
+========================================
+-----BEGIN CERTIFICATE-----
+MIIDfDCCAmSgAwIBAgIQGKy1av1pthU6Y2yv2vrEoTANBgkqhkiG9w0BAQUFADBYMQswCQYDVQQG
+EwJVUzEWMBQGA1UEChMNR2VvVHJ1c3QgSW5jLjExMC8GA1UEAxMoR2VvVHJ1c3QgUHJpbWFyeSBD
+ZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTAeFw0wNjExMjcwMDAwMDBaFw0zNjA3MTYyMzU5NTlaMFgx
+CzAJBgNVBAYTAlVTMRYwFAYDVQQKEw1HZW9UcnVzdCBJbmMuMTEwLwYDVQQDEyhHZW9UcnVzdCBQ
+cmltYXJ5IENlcnRpZmljYXRpb24gQXV0aG9yaXR5MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB
+CgKCAQEAvrgVe//UfH1nrYNke8hCUy3f9oQIIGHWAVlqnEQRr+92/ZV+zmEwu3qDXwK9AWbK7hWN
+b6EwnL2hhZ6UOvNWiAAxz9juapYC2e0DjPt1befquFUWBRaa9OBesYjAZIVcFU2Ix7e64HXprQU9
+nceJSOC7KMgD4TCTZF5SwFlwIjVXiIrxlQqD17wxcwE07e9GceBrAqg1cmuXm2bgyxx5X9gaBGge
+RwLmnWDiNpcB3841kt++Z8dtd1k7j53WkBWUvEI0EME5+bEnPn7WinXFsq+W06Lem+SYvn3h6YGt
+tm/81w7a4DSwDRp35+MImO9Y+pyEtzavwt+s0vQQBnBxNQIDAQABo0IwQDAPBgNVHRMBAf8EBTAD
+AQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQULNVQQZcVi/CPNmFbSvtr2ZnJM5IwDQYJKoZI
+hvcNAQEFBQADggEBAFpwfyzdtzRP9YZRqSa+S7iq8XEN3GHHoOo0Hnp3DwQ16CePbJC/kRYkRj5K
+Ts4rFtULUh38H2eiAkUxT87z+gOneZ1TatnaYzr4gNfTmeGl4b7UVXGYNTq+k+qurUKykG/g/CFN
+NWMziUnWm07Kx+dOCQD32sfvmWKZd7aVIl6KoKv0uHiYyjgZmclynnjNS6yvGaBzEi38wkG6gZHa
+Floxt/m0cYASSJlyc1pZU8FjUjPtp8nSOQJw+uCxQmYpqptR7TBUIhRf2asdweSU8Pj1K/fqynhG
+1riR/aYNKxoUAT6A8EKglQdebc3MS6RFjasS6LPeWuWgfOgPIh1a6Vk=
+-----END CERTIFICATE-----
+
+thawte Primary Root CA
+======================
+-----BEGIN CERTIFICATE-----
+MIIEIDCCAwigAwIBAgIQNE7VVyDV7exJ9C/ON9srbTANBgkqhkiG9w0BAQUFADCBqTELMAkGA1UE
+BhMCVVMxFTATBgNVBAoTDHRoYXd0ZSwgSW5jLjEoMCYGA1UECxMfQ2VydGlmaWNhdGlvbiBTZXJ2
+aWNlcyBEaXZpc2lvbjE4MDYGA1UECxMvKGMpIDIwMDYgdGhhd3RlLCBJbmMuIC0gRm9yIGF1dGhv
+cml6ZWQgdXNlIG9ubHkxHzAdBgNVBAMTFnRoYXd0ZSBQcmltYXJ5IFJvb3QgQ0EwHhcNMDYxMTE3
+MDAwMDAwWhcNMzYwNzE2MjM1OTU5WjCBqTELMAkGA1UEBhMCVVMxFTATBgNVBAoTDHRoYXd0ZSwg
+SW5jLjEoMCYGA1UECxMfQ2VydGlmaWNhdGlvbiBTZXJ2aWNlcyBEaXZpc2lvbjE4MDYGA1UECxMv
+KGMpIDIwMDYgdGhhd3RlLCBJbmMuIC0gRm9yIGF1dGhvcml6ZWQgdXNlIG9ubHkxHzAdBgNVBAMT
+FnRoYXd0ZSBQcmltYXJ5IFJvb3QgQ0EwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCs
+oPD7gFnUnMekz52hWXMJEEUMDSxuaPFsW0hoSVk3/AszGcJ3f8wQLZU0HObrTQmnHNK4yZc2AreJ
+1CRfBsDMRJSUjQJib+ta3RGNKJpchJAQeg29dGYvajig4tVUROsdB58Hum/u6f1OCyn1PoSgAfGc
+q/gcfomk6KHYcWUNo1F77rzSImANuVud37r8UVsLr5iy6S7pBOhih94ryNdOwUxkHt3Ph1i6Sk/K
+aAcdHJ1KxtUvkcx8cXIcxcBn6zL9yZJclNqFwJu/U30rCfSMnZEfl2pSy94JNqR32HuHUETVPm4p
+afs5SSYeCaWAe0At6+gnhcn+Yf1+5nyXHdWdAgMBAAGjQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYD
+VR0PAQH/BAQDAgEGMB0GA1UdDgQWBBR7W0XPr87Lev0xkhpqtvNG61dIUDANBgkqhkiG9w0BAQUF
+AAOCAQEAeRHAS7ORtvzw6WfUDW5FvlXok9LOAz/t2iWwHVfLHjp2oEzsUHboZHIMpKnxuIvW1oeE
+uzLlQRHAd9mzYJ3rG9XRbkREqaYB7FViHXe4XI5ISXycO1cRrK1zN44veFyQaEfZYGDm/Ac9IiAX
+xPcW6cTYcvnIc3zfFi8VqT79aie2oetaupgf1eNNZAqdE8hhuvU5HIe6uL17In/2/qxAeeWsEG89
+jxt5dovEN7MhGITlNgDrYyCZuen+MwS7QcjBAvlEYyCegc5C09Y/LHbTY5xZ3Y+m4Q6gLkH3LpVH
+z7z9M/P2C2F+fpErgUfCJzDupxBdN49cOSvkBPB7jVaMaA==
+-----END CERTIFICATE-----
+
+VeriSign Class 3 Public Primary Certification Authority - G5
+============================================================
+-----BEGIN CERTIFICATE-----
+MIIE0zCCA7ugAwIBAgIQGNrRniZ96LtKIVjNzGs7SjANBgkqhkiG9w0BAQUFADCByjELMAkGA1UE
+BhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQLExZWZXJpU2lnbiBUcnVzdCBO
+ZXR3b3JrMTowOAYDVQQLEzEoYykgMjAwNiBWZXJpU2lnbiwgSW5jLiAtIEZvciBhdXRob3JpemVk
+IHVzZSBvbmx5MUUwQwYDVQQDEzxWZXJpU2lnbiBDbGFzcyAzIFB1YmxpYyBQcmltYXJ5IENlcnRp
+ZmljYXRpb24gQXV0aG9yaXR5IC0gRzUwHhcNMDYxMTA4MDAwMDAwWhcNMzYwNzE2MjM1OTU5WjCB
+yjELMAkGA1UEBhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQLExZWZXJpU2ln
+biBUcnVzdCBOZXR3b3JrMTowOAYDVQQLEzEoYykgMjAwNiBWZXJpU2lnbiwgSW5jLiAtIEZvciBh
+dXRob3JpemVkIHVzZSBvbmx5MUUwQwYDVQQDEzxWZXJpU2lnbiBDbGFzcyAzIFB1YmxpYyBQcmlt
+YXJ5IENlcnRpZmljYXRpb24gQXV0aG9yaXR5IC0gRzUwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAw
+ggEKAoIBAQCvJAgIKXo1nmAMqudLO07cfLw8RRy7K+D+KQL5VwijZIUVJ/XxrcgxiV0i6CqqpkKz
+j/i5Vbext0uz/o9+B1fs70PbZmIVYc9gDaTY3vjgw2IIPVQT60nKWVSFJuUrjxuf6/WhkcIzSdhD
+Y2pSS9KP6HBRTdGJaXvHcPaz3BJ023tdS1bTlr8Vd6Gw9KIl8q8ckmcY5fQGBO+QueQA5N06tRn/
+Arr0PO7gi+s3i+z016zy9vA9r911kTMZHRxAy3QkGSGT2RT+rCpSx4/VBEnkjWNHiDxpg8v+R70r
+fk/Fla4OndTRQ8Bnc+MUCH7lP59zuDMKz10/NIeWiu5T6CUVAgMBAAGjgbIwga8wDwYDVR0TAQH/
+BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwbQYIKwYBBQUHAQwEYTBfoV2gWzBZMFcwVRYJaW1hZ2Uv
+Z2lmMCEwHzAHBgUrDgMCGgQUj+XTGoasjY5rw8+AatRIGCx7GS4wJRYjaHR0cDovL2xvZ28udmVy
+aXNpZ24uY29tL3ZzbG9nby5naWYwHQYDVR0OBBYEFH/TZafC3ey78DAJ80M5+gKvMzEzMA0GCSqG
+SIb3DQEBBQUAA4IBAQCTJEowX2LP2BqYLz3q3JktvXf2pXkiOOzEp6B4Eq1iDkVwZMXnl2YtmAl+
+X6/WzChl8gGqCBpH3vn5fJJaCGkgDdk+bW48DW7Y5gaRQBi5+MHt39tBquCWIMnNZBU4gcmU7qKE
+KQsTb47bDN0lAtukixlE0kF6BWlKWE9gyn6CagsCqiUXObXbf+eEZSqVir2G3l6BFoMtEMze/aiC
+Km0oHw0LxOXnGiYZ4fQRbxC1lfznQgUy286dUV4otp6F01vvpX1FQHKOtw5rDgb7MzVIcbidJ4vE
+ZV8NhnacRHr2lVz2XTIIM6RUthg/aFzyQkqFOFSDX9HoLPKsEdao7WNq
+-----END CERTIFICATE-----
+
+SecureTrust CA
+==============
+-----BEGIN CERTIFICATE-----
+MIIDuDCCAqCgAwIBAgIQDPCOXAgWpa1Cf/DrJxhZ0DANBgkqhkiG9w0BAQUFADBIMQswCQYDVQQG
+EwJVUzEgMB4GA1UEChMXU2VjdXJlVHJ1c3QgQ29ycG9yYXRpb24xFzAVBgNVBAMTDlNlY3VyZVRy
+dXN0IENBMB4XDTA2MTEwNzE5MzExOFoXDTI5MTIzMTE5NDA1NVowSDELMAkGA1UEBhMCVVMxIDAe
+BgNVBAoTF1NlY3VyZVRydXN0IENvcnBvcmF0aW9uMRcwFQYDVQQDEw5TZWN1cmVUcnVzdCBDQTCC
+ASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAKukgeWVzfX2FI7CT8rU4niVWJxB4Q2ZQCQX
+OZEzZum+4YOvYlyJ0fwkW2Gz4BERQRwdbvC4u/jep4G6pkjGnx29vo6pQT64lO0pGtSO0gMdA+9t
+DWccV9cGrcrI9f4Or2YlSASWC12juhbDCE/RRvgUXPLIXgGZbf2IzIaowW8xQmxSPmjL8xk037uH
+GFaAJsTQ3MBv396gwpEWoGQRS0S8Hvbn+mPeZqx2pHGj7DaUaHp3pLHnDi+BeuK1cobvomuL8A/b
+01k/unK8RCSc43Oz969XL0Imnal0ugBS8kvNU3xHCzaFDmapCJcWNFfBZveA4+1wVMeT4C4oFVmH
+ursCAwEAAaOBnTCBmjATBgkrBgEEAYI3FAIEBh4EAEMAQTALBgNVHQ8EBAMCAYYwDwYDVR0TAQH/
+BAUwAwEB/zAdBgNVHQ4EFgQUQjK2FvoE/f5dS3rD/fdMQB1aQ68wNAYDVR0fBC0wKzApoCegJYYj
+aHR0cDovL2NybC5zZWN1cmV0cnVzdC5jb20vU1RDQS5jcmwwEAYJKwYBBAGCNxUBBAMCAQAwDQYJ
+KoZIhvcNAQEFBQADggEBADDtT0rhWDpSclu1pqNlGKa7UTt36Z3q059c4EVlew3KW+JwULKUBRSu
+SceNQQcSc5R+DCMh/bwQf2AQWnL1mA6s7Ll/3XpvXdMc9P+IBWlCqQVxyLesJugutIxq/3HcuLHf
+mbx8IVQr5Fiiu1cprp6poxkmD5kuCLDv/WnPmRoJjeOnnyvJNjR7JLN4TJUXpAYmHrZkUjZfYGfZ
+nMUFdAvnZyPSCPyI6a6Lf+Ew9Dd+/cYy2i2eRDAwbO4H3tI0/NL/QPZL9GZGBlSm8jIKYyYwa5vR
+3ItHuuG51WLQoqD0ZwV4KWMabwTW+MZMo5qxN7SN5ShLHZ4swrhovO0C7jE=
+-----END CERTIFICATE-----
+
+Secure Global CA
+================
+-----BEGIN CERTIFICATE-----
+MIIDvDCCAqSgAwIBAgIQB1YipOjUiolN9BPI8PjqpTANBgkqhkiG9w0BAQUFADBKMQswCQYDVQQG
+EwJVUzEgMB4GA1UEChMXU2VjdXJlVHJ1c3QgQ29ycG9yYXRpb24xGTAXBgNVBAMTEFNlY3VyZSBH
+bG9iYWwgQ0EwHhcNMDYxMTA3MTk0MjI4WhcNMjkxMjMxMTk1MjA2WjBKMQswCQYDVQQGEwJVUzEg
+MB4GA1UEChMXU2VjdXJlVHJ1c3QgQ29ycG9yYXRpb24xGTAXBgNVBAMTEFNlY3VyZSBHbG9iYWwg
+Q0EwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCvNS7YrGxVaQZx5RNoJLNP2MwhR/jx
+YDiJiQPpvepeRlMJ3Fz1Wuj3RSoC6zFh1ykzTM7HfAo3fg+6MpjhHZevj8fcyTiW89sa/FHtaMbQ
+bqR8JNGuQsiWUGMu4P51/pinX0kuleM5M2SOHqRfkNJnPLLZ/kG5VacJjnIFHovdRIWCQtBJwB1g
+8NEXLJXr9qXBkqPFwqcIYA1gBBCWeZ4WNOaptvolRTnIHmX5k/Wq8VLcmZg9pYYaDDUz+kulBAYV
+HDGA76oYa8J719rO+TMg1fW9ajMtgQT7sFzUnKPiXB3jqUJ1XnvUd+85VLrJChgbEplJL4hL/VBi
+0XPnj3pDAgMBAAGjgZ0wgZowEwYJKwYBBAGCNxQCBAYeBABDAEEwCwYDVR0PBAQDAgGGMA8GA1Ud
+EwEB/wQFMAMBAf8wHQYDVR0OBBYEFK9EBMJBfkiD2045AuzshHrmzsmkMDQGA1UdHwQtMCswKaAn
+oCWGI2h0dHA6Ly9jcmwuc2VjdXJldHJ1c3QuY29tL1NHQ0EuY3JsMBAGCSsGAQQBgjcVAQQDAgEA
+MA0GCSqGSIb3DQEBBQUAA4IBAQBjGghAfaReUw132HquHw0LURYD7xh8yOOvaliTFGCRsoTciE6+
+OYo68+aCiV0BN7OrJKQVDpI1WkpEXk5X+nXOH0jOZvQ8QCaSmGwb7iRGDBezUqXbpZGRzzfTb+cn
+CDpOGR86p1hcF895P4vkp9MmI50mD1hp/Ed+stCNi5O/KU9DaXR2Z0vPB4zmAve14bRDtUstFJ/5
+3CYNv6ZHdAbYiNE6KTCEztI5gGIbqMdXSbxqVVFnFUq+NQfk1XWYN3kwFNspnWzFacxHVaIw98xc
+f8LDmBxrThaA63p4ZUWiABqvDA1VZDRIuJK58bRQKfJPIx/abKwfROHdI3hRW8cW
+-----END CERTIFICATE-----
+
+COMODO Certification Authority
+==============================
+-----BEGIN CERTIFICATE-----
+MIIEHTCCAwWgAwIBAgIQToEtioJl4AsC7j41AkblPTANBgkqhkiG9w0BAQUFADCBgTELMAkGA1UE
+BhMCR0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4GA1UEBxMHU2FsZm9yZDEaMBgG
+A1UEChMRQ09NT0RPIENBIExpbWl0ZWQxJzAlBgNVBAMTHkNPTU9ETyBDZXJ0aWZpY2F0aW9uIEF1
+dGhvcml0eTAeFw0wNjEyMDEwMDAwMDBaFw0yOTEyMzEyMzU5NTlaMIGBMQswCQYDVQQGEwJHQjEb
+MBkGA1UECBMSR3JlYXRlciBNYW5jaGVzdGVyMRAwDgYDVQQHEwdTYWxmb3JkMRowGAYDVQQKExFD
+T01PRE8gQ0EgTGltaXRlZDEnMCUGA1UEAxMeQ09NT0RPIENlcnRpZmljYXRpb24gQXV0aG9yaXR5
+MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA0ECLi3LjkRv3UcEbVASY06m/weaKXTuH
++7uIzg3jLz8GlvCiKVCZrts7oVewdFFxze1CkU1B/qnI2GqGd0S7WWaXUF601CxwRM/aN5VCaTww
+xHGzUvAhTaHYujl8HJ6jJJ3ygxaYqhZ8Q5sVW7euNJH+1GImGEaaP+vB+fGQV+useg2L23IwambV
+4EajcNxo2f8ESIl33rXp+2dtQem8Ob0y2WIC8bGoPW43nOIv4tOiJovGuFVDiOEjPqXSJDlqR6sA
+1KGzqSX+DT+nHbrTUcELpNqsOO9VUCQFZUaTNE8tja3G1CEZ0o7KBWFxB3NH5YoZEr0ETc5OnKVI
+rLsm9wIDAQABo4GOMIGLMB0GA1UdDgQWBBQLWOWLxkwVN6RAqTCpIb5HNlpW/zAOBgNVHQ8BAf8E
+BAMCAQYwDwYDVR0TAQH/BAUwAwEB/zBJBgNVHR8EQjBAMD6gPKA6hjhodHRwOi8vY3JsLmNvbW9k
+b2NhLmNvbS9DT01PRE9DZXJ0aWZpY2F0aW9uQXV0aG9yaXR5LmNybDANBgkqhkiG9w0BAQUFAAOC
+AQEAPpiem/Yb6dc5t3iuHXIYSdOH5EOC6z/JqvWote9VfCFSZfnVDeFs9D6Mk3ORLgLETgdxb8CP
+OGEIqB6BCsAvIC9Bi5HcSEW88cbeunZrM8gALTFGTO3nnc+IlP8zwFboJIYmuNg4ON8qa90SzMc/
+RxdMosIGlgnW2/4/PEZB31jiVg88O8EckzXZOFKs7sjsLjBOlDW0JB9LeGna8gI4zJVSk/BwJVmc
+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-----
+MIICiTCCAg+gAwIBAgIQH0evqmIAcFBUTAGem2OZKjAKBggqhkjOPQQDAzCBhTELMAkGA1UEBhMC
+R0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4GA1UEBxMHU2FsZm9yZDEaMBgGA1UE
+ChMRQ09NT0RPIENBIExpbWl0ZWQxKzApBgNVBAMTIkNPTU9ETyBFQ0MgQ2VydGlmaWNhdGlvbiBB
+dXRob3JpdHkwHhcNMDgwMzA2MDAwMDAwWhcNMzgwMTE4MjM1OTU5WjCBhTELMAkGA1UEBhMCR0Ix
+GzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4GA1UEBxMHU2FsZm9yZDEaMBgGA1UEChMR
+Q09NT0RPIENBIExpbWl0ZWQxKzApBgNVBAMTIkNPTU9ETyBFQ0MgQ2VydGlmaWNhdGlvbiBBdXRo
+b3JpdHkwdjAQBgcqhkjOPQIBBgUrgQQAIgNiAAQDR3svdcmCFYX7deSRFtSrYpn1PlILBs5BAH+X
+4QokPB0BBO490o0JlwzgdeT6+3eKKvUDYEs2ixYjFq0JcfRK9ChQtP6IHG4/bC8vCVlbpVsLM5ni
+wz2J+Wos77LTBumjQjBAMB0GA1UdDgQWBBR1cacZSBm8nZ3qQUfflMRId5nTeTAOBgNVHQ8BAf8E
+BAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAKBggqhkjOPQQDAwNoADBlAjEA7wNbeqy3eApyt4jf/7VG
+FAkK+qDmfQjGGoe9GKhzvSbKYAydzpmfz1wPMOG+FDHqAjAU9JM8SaczepBGR7NjfRObTrdvGDeA
+U/7dIOA1mjbRxwG55tzd8/8dLDoWV9mSOdY=
+-----END CERTIFICATE-----
+
+Security Communication EV RootCA1
+=================================
+-----BEGIN CERTIFICATE-----
+MIIDfTCCAmWgAwIBAgIBADANBgkqhkiG9w0BAQUFADBgMQswCQYDVQQGEwJKUDElMCMGA1UEChMc
+U0VDT00gVHJ1c3QgU3lzdGVtcyBDTy4sTFRELjEqMCgGA1UECxMhU2VjdXJpdHkgQ29tbXVuaWNh
+dGlvbiBFViBSb290Q0ExMB4XDTA3MDYwNjAyMTIzMloXDTM3MDYwNjAyMTIzMlowYDELMAkGA1UE
+BhMCSlAxJTAjBgNVBAoTHFNFQ09NIFRydXN0IFN5c3RlbXMgQ08uLExURC4xKjAoBgNVBAsTIVNl
+Y3VyaXR5IENvbW11bmljYXRpb24gRVYgUm9vdENBMTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCC
+AQoCggEBALx/7FebJOD+nLpCeamIivqA4PUHKUPqjgo0No0c+qe1OXj/l3X3L+SqawSERMqm4miO
+/VVQYg+kcQ7OBzgtQoVQrTyWb4vVog7P3kmJPdZkLjjlHmy1V4qe70gOzXppFodEtZDkBp2uoQSX
+WHnvIEqCa4wiv+wfD+mEce3xDuS4GBPMVjZd0ZoeUWs5bmB2iDQL87PRsJ3KYeJkHcFGB7hj3R4z
+ZbOOCVVSPbW9/wfrrWFVGCypaZhKqkDFMxRldAD5kd6vA0jFQFTcD4SQaCDFkpbcLuUCRarAX1T4
+bepJz11sS6/vmsJWXMY1VkJqMF/Cq/biPT+zyRGPMUzXn0kCAwEAAaNCMEAwHQYDVR0OBBYEFDVK
+9U2vP9eCOKyrcWUXdYydVZPmMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MA0GCSqG
+SIb3DQEBBQUAA4IBAQCoh+ns+EBnXcPBZsdAS5f8hxOQWsTvoMpfi7ent/HWtWS3irO4G8za+6xm
+iEHO6Pzk2x6Ipu0nUBsCMCRGef4Eh3CXQHPRwMFXGZpppSeZq51ihPZRwSzJIxXYKLerJRO1RuGG
+Av8mjMSIkh1W/hln8lXkgKNrnKt34VFxDSDbEJrbvXZ5B3eZKK2aXtqxT0QsNY6llsf9g/BYxnnW
+mHyojf6GPgcWkuF75x3sM3Z+Qi5KhfmRiWiEA4Glm5q+4zfFVKtWOxgtQaQM+ELbmaDgcm+7XeEW
+T1MKZPlO9L9OVL14bIjqv5wTJMJwaaJ/D8g8rQjJsJhAoyrniIPtd490
+-----END CERTIFICATE-----
+
+OISTE WISeKey Global Root GA CA
+===============================
+-----BEGIN CERTIFICATE-----
+MIID8TCCAtmgAwIBAgIQQT1yx/RrH4FDffHSKFTfmjANBgkqhkiG9w0BAQUFADCBijELMAkGA1UE
+BhMCQ0gxEDAOBgNVBAoTB1dJU2VLZXkxGzAZBgNVBAsTEkNvcHlyaWdodCAoYykgMjAwNTEiMCAG
+A1UECxMZT0lTVEUgRm91bmRhdGlvbiBFbmRvcnNlZDEoMCYGA1UEAxMfT0lTVEUgV0lTZUtleSBH
+bG9iYWwgUm9vdCBHQSBDQTAeFw0wNTEyMTExNjAzNDRaFw0zNzEyMTExNjA5NTFaMIGKMQswCQYD
+VQQGEwJDSDEQMA4GA1UEChMHV0lTZUtleTEbMBkGA1UECxMSQ29weXJpZ2h0IChjKSAyMDA1MSIw
+IAYDVQQLExlPSVNURSBGb3VuZGF0aW9uIEVuZG9yc2VkMSgwJgYDVQQDEx9PSVNURSBXSVNlS2V5
+IEdsb2JhbCBSb290IEdBIENBMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAy0+zAJs9
+Nt350UlqaxBJH+zYK7LG+DKBKUOVTJoZIyEVRd7jyBxRVVuuk+g3/ytr6dTqvirdqFEr12bDYVxg
+Asj1znJ7O7jyTmUIms2kahnBAbtzptf2w93NvKSLtZlhuAGio9RN1AU9ka34tAhxZK9w8RxrfvbD
+d50kc3vkDIzh2TbhmYsFmQvtRTEJysIA2/dyoJaqlYfQjse2YXMNdmaM3Bu0Y6Kff5MTMPGhJ9vZ
+/yxViJGg4E8HsChWjBgbl0SOid3gF27nKu+POQoxhILYQBRJLnpB5Kf+42TMwVlxSywhp1t94B3R
+LoGbw9ho972WG6xwsRYUC9tguSYBBQIDAQABo1EwTzALBgNVHQ8EBAMCAYYwDwYDVR0TAQH/BAUw
+AwEB/zAdBgNVHQ4EFgQUswN+rja8sHnR3JQmthG+IbJphpQwEAYJKwYBBAGCNxUBBAMCAQAwDQYJ
+KoZIhvcNAQEFBQADggEBAEuh/wuHbrP5wUOxSPMowB0uyQlB+pQAHKSkq0lPjz0e701vvbyk9vIm
+MMkQyh2I+3QZH4VFvbBsUfk2ftv1TDI6QU9bR8/oCy22xBmddMVHxjtqD6wU2zz0c5ypBd8A3HR4
++vg1YFkCExh8vPtNsCBtQ7tgMHpnM1zFmdH4LTlSc/uMqpclXHLZCB6rTjzjgTGfA6b7wP4piFXa
+hNVQA7bihKOmNqoROgHhGEvWRGizPflTdISzRpFGlgC3gCy24eMQ4tui5yiPAZZiFj4A4xylNoEY
+okxSdsARo27mHbrjWr42U8U+dY+GaSlYU7Wcu2+fXMUY7N0v4ZjJ/L7fCg0=
+-----END CERTIFICATE-----
+
+Certigna
+========
+-----BEGIN CERTIFICATE-----
+MIIDqDCCApCgAwIBAgIJAP7c4wEPyUj/MA0GCSqGSIb3DQEBBQUAMDQxCzAJBgNVBAYTAkZSMRIw
+EAYDVQQKDAlEaGlteW90aXMxETAPBgNVBAMMCENlcnRpZ25hMB4XDTA3MDYyOTE1MTMwNVoXDTI3
+MDYyOTE1MTMwNVowNDELMAkGA1UEBhMCRlIxEjAQBgNVBAoMCURoaW15b3RpczERMA8GA1UEAwwI
+Q2VydGlnbmEwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDIaPHJ1tazNHUmgh7stL7q
+XOEm7RFHYeGifBZ4QCHkYJ5ayGPhxLGWkv8YbWkj4Sti993iNi+RB7lIzw7sebYs5zRLcAglozyH
+GxnygQcPOJAZ0xH+hrTy0V4eHpbNgGzOOzGTtvKg0KmVEn2lmsxryIRWijOp5yIVUxbwzBfsV1/p
+ogqYCd7jX5xv3EjjhQsVWqa6n6xI4wmy9/Qy3l40vhx4XUJbzg4ij02Q130yGLMLLGq/jj8UEYkg
+DncUtT2UCIf3JR7VsmAA7G8qKCVuKj4YYxclPz5EIBb2JsglrgVKtOdjLPOMFlN+XPsRGgjBRmKf
+Irjxwo1p3Po6WAbfAgMBAAGjgbwwgbkwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQUGu3+QTmQ
+tCRZvgHyUtVF9lo53BEwZAYDVR0jBF0wW4AUGu3+QTmQtCRZvgHyUtVF9lo53BGhOKQ2MDQxCzAJ
+BgNVBAYTAkZSMRIwEAYDVQQKDAlEaGlteW90aXMxETAPBgNVBAMMCENlcnRpZ25hggkA/tzjAQ/J
+SP8wDgYDVR0PAQH/BAQDAgEGMBEGCWCGSAGG+EIBAQQEAwIABzANBgkqhkiG9w0BAQUFAAOCAQEA
+hQMeknH2Qq/ho2Ge6/PAD/Kl1NqV5ta+aDY9fm4fTIrv0Q8hbV6lUmPOEvjvKtpv6zf+EwLHyzs+
+ImvaYS5/1HI93TDhHkxAGYwP15zRgzB7mFncfca5DClMoTOi62c6ZYTTluLtdkVwj7Ur3vkj1klu
+PBS1xp81HlDQwY9qcEQCYsuuHWhBp6pX6FOqB9IG9tUUBguRA3UsbHK1YZWaDYu5Def131TN3ubY
+1gkIl2PlwS6wt0QmwCbAr1UwnjvVNioZBPRcHv/PLLf/0P2HQBHVESO7SMAhqaQoLf0V+LBOK/Qw
+WyH8EZE0vkHve52Xdf+XlcCWWC/qu0bXu+TZLg==
+-----END CERTIFICATE-----
+
+Deutsche Telekom Root CA 2
+==========================
+-----BEGIN CERTIFICATE-----
+MIIDnzCCAoegAwIBAgIBJjANBgkqhkiG9w0BAQUFADBxMQswCQYDVQQGEwJERTEcMBoGA1UEChMT
+RGV1dHNjaGUgVGVsZWtvbSBBRzEfMB0GA1UECxMWVC1UZWxlU2VjIFRydXN0IENlbnRlcjEjMCEG
+A1UEAxMaRGV1dHNjaGUgVGVsZWtvbSBSb290IENBIDIwHhcNOTkwNzA5MTIxMTAwWhcNMTkwNzA5
+MjM1OTAwWjBxMQswCQYDVQQGEwJERTEcMBoGA1UEChMTRGV1dHNjaGUgVGVsZWtvbSBBRzEfMB0G
+A1UECxMWVC1UZWxlU2VjIFRydXN0IENlbnRlcjEjMCEGA1UEAxMaRGV1dHNjaGUgVGVsZWtvbSBS
+b290IENBIDIwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCrC6M14IspFLEUha88EOQ5
+bzVdSq7d6mGNlUn0b2SjGmBmpKlAIoTZ1KXleJMOaAGtuU1cOs7TuKhCQN/Po7qCWWqSG6wcmtoI
+KyUn+WkjR/Hg6yx6m/UTAtB+NHzCnjwAWav12gz1MjwrrFDa1sPeg5TKqAyZMg4ISFZbavva4VhY
+AUlfckE8FQYBjl2tqriTtM2e66foai1SNNs671x1Udrb8zH57nGYMsRUFUQM+ZtV7a3fGAigo4aK
+Se5TBY8ZTNXeWHmb0mocQqvF1afPaA+W5OFhmHZhyJF81j4A4pFQh+GdCuatl9Idxjp9y7zaAzTV
+jlsB9WoHtxa2bkp/AgMBAAGjQjBAMB0GA1UdDgQWBBQxw3kbuvVT1xfgiXotF2wKsyudMzAPBgNV
+HRMECDAGAQH/AgEFMA4GA1UdDwEB/wQEAwIBBjANBgkqhkiG9w0BAQUFAAOCAQEAlGRZrTlk5ynr
+E/5aw4sTV8gEJPB0d8Bg42f76Ymmg7+Wgnxu1MM9756AbrsptJh6sTtU6zkXR34ajgv8HzFZMQSy
+zhfzLMdiNlXiItiJVbSYSKpk+tYcNthEeFpaIzpXl/V6ME+un2pMSyuOoAPjPuCp1NJ70rOo4nI8
+rZ7/gFnkm0W09juwzTkZmDLl6iFhkOQxIY40sfcvNUqFENrnijchvllj4PKFiDFT1FQUhXB59C4G
+dyd1Lx+4ivn+xbrYNuSD7Odlt79jWvNGr4GUN9RBjNYj1h7P9WgbRGOiWrqnNVmh5XAFmw4jV5mU
+Cm26OWMohpLzGITY+9HPBVZkVw==
+-----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-----
+MIIFsDCCA5igAwIBAgIQFci9ZUdcr7iXAF7kBtK8nTANBgkqhkiG9w0BAQUFADBeMQswCQYDVQQG
+EwJUVzEjMCEGA1UECgwaQ2h1bmdod2EgVGVsZWNvbSBDby4sIEx0ZC4xKjAoBgNVBAsMIWVQS0kg
+Um9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTAeFw0wNDEyMjAwMjMxMjdaFw0zNDEyMjAwMjMx
+MjdaMF4xCzAJBgNVBAYTAlRXMSMwIQYDVQQKDBpDaHVuZ2h3YSBUZWxlY29tIENvLiwgTHRkLjEq
+MCgGA1UECwwhZVBLSSBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5MIICIjANBgkqhkiG9w0B
+AQEFAAOCAg8AMIICCgKCAgEA4SUP7o3biDN1Z82tH306Tm2d0y8U82N0ywEhajfqhFAHSyZbCUNs
+IZ5qyNUD9WBpj8zwIuQf5/dqIjG3LBXy4P4AakP/h2XGtRrBp0xtInAhijHyl3SJCRImHJ7K2RKi
+lTza6We/CKBk49ZCt0Xvl/T29de1ShUCWH2YWEtgvM3XDZoTM1PRYfl61dd4s5oz9wCGzh1NlDiv
+qOx4UXCKXBCDUSH3ET00hl7lSM2XgYI1TBnsZfZrxQWh7kcT1rMhJ5QQCtkkO7q+RBNGMD+XPNjX
+12ruOzjjK9SXDrkb5wdJfzcq+Xd4z1TtW0ado4AOkUPB1ltfFLqfpo0kR0BZv3I4sjZsN/+Z0V0O
+WQqraffAsgRFelQArr5T9rXn4fg8ozHSqf4hUmTFpmfwdQcGlBSBVcYn5AGPF8Fqcde+S/uUWH1+
+ETOxQvdibBjWzwloPn9s9h6PYq2lY9sJpx8iQkEeb5mKPtf5P0B6ebClAZLSnT0IFaUQAS2zMnao
+lQ2zepr7BxB4EW/hj8e6DyUadCrlHJhBmd8hh+iVBmoKs2pHdmX2Os+PYhcZewoozRrSgx4hxyy/
+vv9haLdnG7t4TY3OZ+XkwY63I2binZB1NJipNiuKmpS5nezMirH4JYlcWrYvjB9teSSnUmjDhDXi
+Zo1jDiVN1Rmy5nk3pyKdVDECAwEAAaNqMGgwHQYDVR0OBBYEFB4M97Zn8uGSJglFwFU5Lnc/Qkqi
+MAwGA1UdEwQFMAMBAf8wOQYEZyoHAAQxMC8wLQIBADAJBgUrDgMCGgUAMAcGBWcqAwAABBRFsMLH
+ClZ87lt4DJX5GFPBphzYEDANBgkqhkiG9w0BAQUFAAOCAgEACbODU1kBPpVJufGBuvl2ICO1J2B0
+1GqZNF5sAFPZn/KmsSQHRGoqxqWOeBLoR9lYGxMqXnmbnwoqZ6YlPwZpVnPDimZI+ymBV3QGypzq
+KOg4ZyYr8dW1P2WT+DZdjo2NQCCHGervJ8A9tDkPJXtoUHRVnAxZfVo9QZQlUgjgRywVMRnVvwdV
+xrsStZf0X4OFunHB2WyBEXYKCrC/gpf36j36+uwtqSiUO1bd0lEursC9CBWMd1I0ltabrNMdjmEP
+NXubrjlpC2JgQCA2j6/7Nu4tCEoduL+bXPjqpRugc6bY+G7gMwRfaKonh+3ZwZCc7b3jajWvY9+r
+GNm65ulK6lCKD2GTHuItGeIwlDWSXQ62B68ZgI9HkFFLLk3dheLSClIKF5r8GrBQAuUBo2M3IUxE
+xJtRmREOc5wGj1QupyheRDmHVi03vYVElOEMSyycw5KFNGHLD7ibSkNS/jQ6fbjpKdx2qcgw+BRx
+gMYeNkh0IkFch4LoGHGLQYlE535YW6i4jRPpp2zDR+2zGp1iro2C6pSe3VkQw63d4k3jMdXH7Ojy
+sP6SHhYKGvzZ8/gntsm+HbRsZJB/9OTEW9c3rkIO3aQab3yIVMUWbuF6aC74Or8NpDyJO3inTmOD
+BCEIZ43ygknQW/2xzQ+DhNQ+IIX3Sj0rnP0qCglN6oH4EZw=
+-----END CERTIFICATE-----
+
+certSIGN ROOT CA
+================
+-----BEGIN CERTIFICATE-----
+MIIDODCCAiCgAwIBAgIGIAYFFnACMA0GCSqGSIb3DQEBBQUAMDsxCzAJBgNVBAYTAlJPMREwDwYD
+VQQKEwhjZXJ0U0lHTjEZMBcGA1UECxMQY2VydFNJR04gUk9PVCBDQTAeFw0wNjA3MDQxNzIwMDRa
+Fw0zMTA3MDQxNzIwMDRaMDsxCzAJBgNVBAYTAlJPMREwDwYDVQQKEwhjZXJ0U0lHTjEZMBcGA1UE
+CxMQY2VydFNJR04gUk9PVCBDQTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBALczuX7I
+JUqOtdu0KBuqV5Do0SLTZLrTk+jUrIZhQGpgV2hUhE28alQCBf/fm5oqrl0Hj0rDKH/v+yv6efHH
+rfAQUySQi2bJqIirr1qjAOm+ukbuW3N7LBeCgV5iLKECZbO9xSsAfsT8AzNXDe3i+s5dRdY4zTW2
+ssHQnIFKquSyAVwdj1+ZxLGt24gh65AIgoDzMKND5pCCrlUoSe1b16kQOA7+j0xbm0bqQfWwCHTD
+0IgztnzXdN/chNFDDnU5oSVAKOp4yw4sLjmdjItuFhwvJoIQ4uNllAoEwF73XVv4EOLQunpL+943
+AAAaWyjj0pxzPjKHmKHJUS/X3qwzs08CAwEAAaNCMEAwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8B
+Af8EBAMCAcYwHQYDVR0OBBYEFOCMm9slSbPxfIbWskKHC9BroNnkMA0GCSqGSIb3DQEBBQUAA4IB
+AQA+0hyJLjX8+HXd5n9liPRyTMks1zJO890ZeUe9jjtbkw9QSSQTaxQGcu8J06Gh40CEyecYMnQ8
+SG4Pn0vU9x7Tk4ZkVJdjclDVVc/6IJMCopvDI5NOFlV2oHB5bc0hH88vLbwZ44gx+FkagQnIl6Z0
+x2DEW8xXjrJ1/RsCCdtZb3KTafcxQdaIOL+Hsr0Wefmq5L6IJd1hJyMctTEHBDa0GpC9oHRxUIlt
+vBTjD4au8as+x6AJzKNI0eDbZOeStc+vckNwi/nDhDwTqn6Sm1dTk/pwwpEOMfmbZ13pljheX7Nz
+TogVZ96edhBiIL5VaZVDADlN9u6wWk5JRFRYX0KD
+-----END CERTIFICATE-----
+
+GeoTrust Primary Certification Authority - G3
+=============================================
+-----BEGIN CERTIFICATE-----
+MIID/jCCAuagAwIBAgIQFaxulBmyeUtB9iepwxgPHzANBgkqhkiG9w0BAQsFADCBmDELMAkGA1UE
+BhMCVVMxFjAUBgNVBAoTDUdlb1RydXN0IEluYy4xOTA3BgNVBAsTMChjKSAyMDA4IEdlb1RydXN0
+IEluYy4gLSBGb3IgYXV0aG9yaXplZCB1c2Ugb25seTE2MDQGA1UEAxMtR2VvVHJ1c3QgUHJpbWFy
+eSBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eSAtIEczMB4XDTA4MDQwMjAwMDAwMFoXDTM3MTIwMTIz
+NTk1OVowgZgxCzAJBgNVBAYTAlVTMRYwFAYDVQQKEw1HZW9UcnVzdCBJbmMuMTkwNwYDVQQLEzAo
+YykgMjAwOCBHZW9UcnVzdCBJbmMuIC0gRm9yIGF1dGhvcml6ZWQgdXNlIG9ubHkxNjA0BgNVBAMT
+LUdlb1RydXN0IFByaW1hcnkgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkgLSBHMzCCASIwDQYJKoZI
+hvcNAQEBBQADggEPADCCAQoCggEBANziXmJYHTNXOTIz+uvLh4yn1ErdBojqZI4xmKU4kB6Yzy5j
+K/BGvESyiaHAKAxJcCGVn2TAppMSAmUmhsalifD614SgcK9PGpc/BkTVyetyEH3kMSj7HGHmKAdE
+c5IiaacDiGydY8hS2pgn5whMcD60yRLBxWeDXTPzAxHsatBT4tG6NmCUgLthY2xbF37fQJQeqw3C
+IShwiP/WJmxsYAQlTlV+fe+/lEjetx3dcI0FX4ilm/LC7urRQEFtYjgdVgbFA0dRIBn8exALDmKu
+dlW/X3e+PkkBUz2YJQN2JFodtNuJ6nnltrM7P7pMKEF/BqxqjsHQ9gUdfeZChuOl1UcCAwEAAaNC
+MEAwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0OBBYEFMR5yo6hTgMdHNxr
+2zFblD4/MH8tMA0GCSqGSIb3DQEBCwUAA4IBAQAtxRPPVoB7eni9n64smefv2t+UXglpp+duaIy9
+cr5HqQ6XErhK8WTTOd8lNNTBzU6B8A8ExCSzNJbGpqow32hhc9f5joWJ7w5elShKKiePEI4ufIbE
+Ap7aDHdlDkQNkv39sxY2+hENHYwOB4lqKVb3cvTdFZx3NWZXqxNT2I7BQMXXExZacse3aQHEerGD
+AWh9jUGhlBjBJVz88P6DAod8DQ3PLghcSkANPuyBYeYk28rgDi0Hsj5W3I31QYUHSJsMC8tJP33s
+t/3LjWeJGqvtux6jAAgIFyqCXDFdRootD4abdNlF+9RAsXqqaC2Gspki4cErx5z481+oghLrGREt
+-----END CERTIFICATE-----
+
+thawte Primary Root CA - G2
+===========================
+-----BEGIN CERTIFICATE-----
+MIICiDCCAg2gAwIBAgIQNfwmXNmET8k9Jj1Xm67XVjAKBggqhkjOPQQDAzCBhDELMAkGA1UEBhMC
+VVMxFTATBgNVBAoTDHRoYXd0ZSwgSW5jLjE4MDYGA1UECxMvKGMpIDIwMDcgdGhhd3RlLCBJbmMu
+IC0gRm9yIGF1dGhvcml6ZWQgdXNlIG9ubHkxJDAiBgNVBAMTG3RoYXd0ZSBQcmltYXJ5IFJvb3Qg
+Q0EgLSBHMjAeFw0wNzExMDUwMDAwMDBaFw0zODAxMTgyMzU5NTlaMIGEMQswCQYDVQQGEwJVUzEV
+MBMGA1UEChMMdGhhd3RlLCBJbmMuMTgwNgYDVQQLEy8oYykgMjAwNyB0aGF3dGUsIEluYy4gLSBG
+b3IgYXV0aG9yaXplZCB1c2Ugb25seTEkMCIGA1UEAxMbdGhhd3RlIFByaW1hcnkgUm9vdCBDQSAt
+IEcyMHYwEAYHKoZIzj0CAQYFK4EEACIDYgAEotWcgnuVnfFSeIf+iha/BebfowJPDQfGAFG6DAJS
+LSKkQjnE/o/qycG+1E3/n3qe4rF8mq2nhglzh9HnmuN6papu+7qzcMBniKI11KOasf2twu8x+qi5
+8/sIxpHR+ymVo0IwQDAPBgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQU
+mtgAMADna3+FGO6Lts6KDPgR4bswCgYIKoZIzj0EAwMDaQAwZgIxAN344FdHW6fmCsO99YCKlzUN
+G4k8VIZ3KMqh9HneteY4sPBlcIx/AlTCv//YoT7ZzwIxAMSNlPzcU9LcnXgWHxUzI1NS41oxXZ3K
+rr0TKUQNJ1uo52icEvdYPy5yAlejj6EULg==
+-----END CERTIFICATE-----
+
+thawte Primary Root CA - G3
+===========================
+-----BEGIN CERTIFICATE-----
+MIIEKjCCAxKgAwIBAgIQYAGXt0an6rS0mtZLL/eQ+zANBgkqhkiG9w0BAQsFADCBrjELMAkGA1UE
+BhMCVVMxFTATBgNVBAoTDHRoYXd0ZSwgSW5jLjEoMCYGA1UECxMfQ2VydGlmaWNhdGlvbiBTZXJ2
+aWNlcyBEaXZpc2lvbjE4MDYGA1UECxMvKGMpIDIwMDggdGhhd3RlLCBJbmMuIC0gRm9yIGF1dGhv
+cml6ZWQgdXNlIG9ubHkxJDAiBgNVBAMTG3RoYXd0ZSBQcmltYXJ5IFJvb3QgQ0EgLSBHMzAeFw0w
+ODA0MDIwMDAwMDBaFw0zNzEyMDEyMzU5NTlaMIGuMQswCQYDVQQGEwJVUzEVMBMGA1UEChMMdGhh
+d3RlLCBJbmMuMSgwJgYDVQQLEx9DZXJ0aWZpY2F0aW9uIFNlcnZpY2VzIERpdmlzaW9uMTgwNgYD
+VQQLEy8oYykgMjAwOCB0aGF3dGUsIEluYy4gLSBGb3IgYXV0aG9yaXplZCB1c2Ugb25seTEkMCIG
+A1UEAxMbdGhhd3RlIFByaW1hcnkgUm9vdCBDQSAtIEczMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8A
+MIIBCgKCAQEAsr8nLPvb2FvdeHsbnndmgcs+vHyu86YnmjSjaDFxODNi5PNxZnmxqWWjpYvVj2At
+P0LMqmsywCPLLEHd5N/8YZzic7IilRFDGF/Eth9XbAoFWCLINkw6fKXRz4aviKdEAhN0cXMKQlkC
++BsUa0Lfb1+6a4KinVvnSr0eAXLbS3ToO39/fR8EtCab4LRarEc9VbjXsCZSKAExQGbY2SS99irY
+7CFJXJv2eul/VTV+lmuNk5Mny5K76qxAwJ/C+IDPXfRa3M50hqY+bAtTyr2SzhkGcuYMXDhpxwTW
+vGzOW/b3aJzcJRVIiKHpqfiYnODz1TEoYRFsZ5aNOZnLwkUkOQIDAQABo0IwQDAPBgNVHRMBAf8E
+BTADAQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUrWyqlGCc7eT/+j4KdCtjA/e2Wb8wDQYJ
+KoZIhvcNAQELBQADggEBABpA2JVlrAmSicY59BDlqQ5mU1143vokkbvnRFHfxhY0Cu9qRFHqKweK
+A3rD6z8KLFIWoCtDuSWQP3CpMyVtRRooOyfPqsMpQhvfO0zAMzRbQYi/aytlryjvsvXDqmbOe1bu
+t8jLZ8HJnBoYuMTDSQPxYA5QzUbF83d597YV4Djbxy8ooAw/dyZ02SUS2jHaGh7cKUGRIjxpp7sC
+8rZcJwOJ9Abqm+RyguOhCcHpABnTPtRwa7pxpqpYrvS76Wy274fMm7v/OeZWYdMKp8RcTGB7BXcm
+er/YB1IsYvdwY9k5vG8cwnncdimvzsUsZAReiDZuMdRAGmI0Nj81Aa6sY6A=
+-----END CERTIFICATE-----
+
+GeoTrust Primary Certification Authority - G2
+=============================================
+-----BEGIN CERTIFICATE-----
+MIICrjCCAjWgAwIBAgIQPLL0SAoA4v7rJDteYD7DazAKBggqhkjOPQQDAzCBmDELMAkGA1UEBhMC
+VVMxFjAUBgNVBAoTDUdlb1RydXN0IEluYy4xOTA3BgNVBAsTMChjKSAyMDA3IEdlb1RydXN0IElu
+Yy4gLSBGb3IgYXV0aG9yaXplZCB1c2Ugb25seTE2MDQGA1UEAxMtR2VvVHJ1c3QgUHJpbWFyeSBD
+ZXJ0aWZpY2F0aW9uIEF1dGhvcml0eSAtIEcyMB4XDTA3MTEwNTAwMDAwMFoXDTM4MDExODIzNTk1
+OVowgZgxCzAJBgNVBAYTAlVTMRYwFAYDVQQKEw1HZW9UcnVzdCBJbmMuMTkwNwYDVQQLEzAoYykg
+MjAwNyBHZW9UcnVzdCBJbmMuIC0gRm9yIGF1dGhvcml6ZWQgdXNlIG9ubHkxNjA0BgNVBAMTLUdl
+b1RydXN0IFByaW1hcnkgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkgLSBHMjB2MBAGByqGSM49AgEG
+BSuBBAAiA2IABBWx6P0DFUPlrOuHNxFi79KDNlJ9RVcLSo17VDs6bl8VAsBQps8lL33KSLjHUGMc
+KiEIfJo22Av+0SbFWDEwKCXzXV2juLaltJLtbCyf691DiaI8S0iRHVDsJt/WYC69IaNCMEAwDwYD
+VR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0OBBYEFBVfNVdRVfslsq0DafwBo/q+
+EVXVMAoGCCqGSM49BAMDA2cAMGQCMGSWWaboCd6LuvpaiIjwH5HTRqjySkwCY/tsXzjbLkGTqQ7m
+ndwxHLKgpxgceeHHNgIwOlavmnRs9vuD4DPTCF+hnMJbn0bWtsuRBmOiBuczrD6ogRLQy7rQkgu2
+npaqBA+K
+-----END CERTIFICATE-----
+
+VeriSign Universal Root Certification Authority
+===============================================
+-----BEGIN CERTIFICATE-----
+MIIEuTCCA6GgAwIBAgIQQBrEZCGzEyEDDrvkEhrFHTANBgkqhkiG9w0BAQsFADCBvTELMAkGA1UE
+BhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQLExZWZXJpU2lnbiBUcnVzdCBO
+ZXR3b3JrMTowOAYDVQQLEzEoYykgMjAwOCBWZXJpU2lnbiwgSW5jLiAtIEZvciBhdXRob3JpemVk
+IHVzZSBvbmx5MTgwNgYDVQQDEy9WZXJpU2lnbiBVbml2ZXJzYWwgUm9vdCBDZXJ0aWZpY2F0aW9u
+IEF1dGhvcml0eTAeFw0wODA0MDIwMDAwMDBaFw0zNzEyMDEyMzU5NTlaMIG9MQswCQYDVQQGEwJV
+UzEXMBUGA1UEChMOVmVyaVNpZ24sIEluYy4xHzAdBgNVBAsTFlZlcmlTaWduIFRydXN0IE5ldHdv
+cmsxOjA4BgNVBAsTMShjKSAyMDA4IFZlcmlTaWduLCBJbmMuIC0gRm9yIGF1dGhvcml6ZWQgdXNl
+IG9ubHkxODA2BgNVBAMTL1ZlcmlTaWduIFVuaXZlcnNhbCBSb290IENlcnRpZmljYXRpb24gQXV0
+aG9yaXR5MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAx2E3XrEBNNti1xWb/1hajCMj
+1mCOkdeQmIN65lgZOIzF9uVkhbSicfvtvbnazU0AtMgtc6XHaXGVHzk8skQHnOgO+k1KxCHfKWGP
+MiJhgsWHH26MfF8WIFFE0XBPV+rjHOPMee5Y2A7Cs0WTwCznmhcrewA3ekEzeOEz4vMQGn+HLL72
+9fdC4uW/h2KJXwBL38Xd5HVEMkE6HnFuacsLdUYI0crSK5XQz/u5QGtkjFdN/BMReYTtXlT2NJ8I
+AfMQJQYXStrxHXpma5hgZqTZ79IugvHw7wnqRMkVauIDbjPTrJ9VAMf2CGqUuV/c4DPxhGD5WycR
+tPwW8rtWaoAljQIDAQABo4GyMIGvMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMG0G
+CCsGAQUFBwEMBGEwX6FdoFswWTBXMFUWCWltYWdlL2dpZjAhMB8wBwYFKw4DAhoEFI/l0xqGrI2O
+a8PPgGrUSBgsexkuMCUWI2h0dHA6Ly9sb2dvLnZlcmlzaWduLmNvbS92c2xvZ28uZ2lmMB0GA1Ud
+DgQWBBS2d/ppSEefUxLVwuoHMnYH0ZcHGTANBgkqhkiG9w0BAQsFAAOCAQEASvj4sAPmLGd75JR3
+Y8xuTPl9Dg3cyLk1uXBPY/ok+myDjEedO2Pzmvl2MpWRsXe8rJq+seQxIcaBlVZaDrHC1LGmWazx
+Y8u4TB1ZkErvkBYoH1quEPuBUDgMbMzxPcP1Y+Oz4yHJJDnp/RVmRvQbEdBNc6N9Rvk97ahfYtTx
+P/jgdFcrGJ2BtMQo2pSXpXDrrB2+BxHw1dvd5Yzw1TKwg+ZX4o+/vqGqvz0dtdQ46tewXDpPaj+P
+wGZsY6rp2aQW9IHRlRQOfc2VNNnSj3BzgXucfr2YYdhFh5iQxeuGMMY1v/D/w1WIg0vvBZIGcfK4
+mJO37M2CYfE45k+XmCpajQ==
+-----END CERTIFICATE-----
+
+VeriSign Class 3 Public Primary Certification Authority - G4
+============================================================
+-----BEGIN CERTIFICATE-----
+MIIDhDCCAwqgAwIBAgIQL4D+I4wOIg9IZxIokYesszAKBggqhkjOPQQDAzCByjELMAkGA1UEBhMC
+VVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQLExZWZXJpU2lnbiBUcnVzdCBOZXR3
+b3JrMTowOAYDVQQLEzEoYykgMjAwNyBWZXJpU2lnbiwgSW5jLiAtIEZvciBhdXRob3JpemVkIHVz
+ZSBvbmx5MUUwQwYDVQQDEzxWZXJpU2lnbiBDbGFzcyAzIFB1YmxpYyBQcmltYXJ5IENlcnRpZmlj
+YXRpb24gQXV0aG9yaXR5IC0gRzQwHhcNMDcxMTA1MDAwMDAwWhcNMzgwMTE4MjM1OTU5WjCByjEL
+MAkGA1UEBhMCVVMxFzAVBgNVBAoTDlZlcmlTaWduLCBJbmMuMR8wHQYDVQQLExZWZXJpU2lnbiBU
+cnVzdCBOZXR3b3JrMTowOAYDVQQLEzEoYykgMjAwNyBWZXJpU2lnbiwgSW5jLiAtIEZvciBhdXRo
+b3JpemVkIHVzZSBvbmx5MUUwQwYDVQQDEzxWZXJpU2lnbiBDbGFzcyAzIFB1YmxpYyBQcmltYXJ5
+IENlcnRpZmljYXRpb24gQXV0aG9yaXR5IC0gRzQwdjAQBgcqhkjOPQIBBgUrgQQAIgNiAASnVnp8
+Utpkmw4tXNherJI9/gHmGUo9FANL+mAnINmDiWn6VMaaGF5VKmTeBvaNSjutEDxlPZCIBIngMGGz
+rl0Bp3vefLK+ymVhAIau2o970ImtTR1ZmkGxvEeA3J5iw/mjgbIwga8wDwYDVR0TAQH/BAUwAwEB
+/zAOBgNVHQ8BAf8EBAMCAQYwbQYIKwYBBQUHAQwEYTBfoV2gWzBZMFcwVRYJaW1hZ2UvZ2lmMCEw
+HzAHBgUrDgMCGgQUj+XTGoasjY5rw8+AatRIGCx7GS4wJRYjaHR0cDovL2xvZ28udmVyaXNpZ24u
+Y29tL3ZzbG9nby5naWYwHQYDVR0OBBYEFLMWkf3upm7ktS5Jj4d4gYDs5bG1MAoGCCqGSM49BAMD
+A2gAMGUCMGYhDBgmYFo4e1ZC4Kf8NoRRkSAsdk1DPcQdhCPQrNZ8NQbOzWm9kA3bbEhCHQ6qQgIx
+AJw9SDkjOVgaFRJZap7v1VmyHVIsmXHNxynfGyphe3HR3vPA5Q06Sqotp9iGKt0uEA==
+-----END CERTIFICATE-----
+
+NetLock Arany (Class Gold) Főtanúsítvány
+========================================
+-----BEGIN CERTIFICATE-----
+MIIEFTCCAv2gAwIBAgIGSUEs5AAQMA0GCSqGSIb3DQEBCwUAMIGnMQswCQYDVQQGEwJIVTERMA8G
+A1UEBwwIQnVkYXBlc3QxFTATBgNVBAoMDE5ldExvY2sgS2Z0LjE3MDUGA1UECwwuVGFuw7pzw610
+dsOhbnlraWFkw7NrIChDZXJ0aWZpY2F0aW9uIFNlcnZpY2VzKTE1MDMGA1UEAwwsTmV0TG9jayBB
+cmFueSAoQ2xhc3MgR29sZCkgRsWRdGFuw7pzw610dsOhbnkwHhcNMDgxMjExMTUwODIxWhcNMjgx
+MjA2MTUwODIxWjCBpzELMAkGA1UEBhMCSFUxETAPBgNVBAcMCEJ1ZGFwZXN0MRUwEwYDVQQKDAxO
+ZXRMb2NrIEtmdC4xNzA1BgNVBAsMLlRhbsO6c8OtdHbDoW55a2lhZMOzayAoQ2VydGlmaWNhdGlv
+biBTZXJ2aWNlcykxNTAzBgNVBAMMLE5ldExvY2sgQXJhbnkgKENsYXNzIEdvbGQpIEbFkXRhbsO6
+c8OtdHbDoW55MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAxCRec75LbRTDofTjl5Bu
+0jBFHjzuZ9lk4BqKf8owyoPjIMHj9DrTlF8afFttvzBPhCf2nx9JvMaZCpDyD/V/Q4Q3Y1GLeqVw
+/HpYzY6b7cNGbIRwXdrzAZAj/E4wqX7hJ2Pn7WQ8oLjJM2P+FpD/sLj916jAwJRDC7bVWaaeVtAk
+H3B5r9s5VA1lddkVQZQBr17s9o3x/61k/iCa11zr/qYfCGSji3ZVrR47KGAuhyXoqq8fxmRGILdw
+fzzeSNuWU7c5d+Qa4scWhHaXWy+7GRWF+GmF9ZmnqfI0p6m2pgP8b4Y9VHx2BJtr+UBdADTHLpl1
+neWIA6pN+APSQnbAGwIDAKiLo0UwQzASBgNVHRMBAf8ECDAGAQH/AgEEMA4GA1UdDwEB/wQEAwIB
+BjAdBgNVHQ4EFgQUzPpnk/C2uNClwB7zU/2MU9+D15YwDQYJKoZIhvcNAQELBQADggEBAKt/7hwW
+qZw8UQCgwBEIBaeZ5m8BiFRhbvG5GK1Krf6BQCOUL/t1fC8oS2IkgYIL9WHxHG64YTjrgfpioTta
+YtOUZcTh5m2C+C8lcLIhJsFyUR+MLMOEkMNaj7rP9KdlpeuY0fsFskZ1FSNqb4VjMIDw1Z4fKRzC
+bLBQWV2QWzuoDTDPv31/zvGdg73JRm4gpvlhUbohL3u+pRVjodSVh/GeufOJ8z2FuLjbvrW5Kfna
+NwUASZQDhETnv0Mxz3WLJdH0pmT1kvarBes96aULNmLazAZfNou2XjG4Kvte9nHfRCaexOYNkbQu
+dZWAUWpLMKawYqGT8ZvYzsRjdT9ZR7E=
+-----END CERTIFICATE-----
+
+Staat der Nederlanden Root CA - G2
+==================================
+-----BEGIN CERTIFICATE-----
+MIIFyjCCA7KgAwIBAgIEAJiWjDANBgkqhkiG9w0BAQsFADBaMQswCQYDVQQGEwJOTDEeMBwGA1UE
+CgwVU3RhYXQgZGVyIE5lZGVybGFuZGVuMSswKQYDVQQDDCJTdGFhdCBkZXIgTmVkZXJsYW5kZW4g
+Um9vdCBDQSAtIEcyMB4XDTA4MDMyNjExMTgxN1oXDTIwMDMyNTExMDMxMFowWjELMAkGA1UEBhMC
+TkwxHjAcBgNVBAoMFVN0YWF0IGRlciBOZWRlcmxhbmRlbjErMCkGA1UEAwwiU3RhYXQgZGVyIE5l
+ZGVybGFuZGVuIFJvb3QgQ0EgLSBHMjCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAMVZ
+5291qj5LnLW4rJ4L5PnZyqtdj7U5EILXr1HgO+EASGrP2uEGQxGZqhQlEq0i6ABtQ8SpuOUfiUtn
+vWFI7/3S4GCI5bkYYCjDdyutsDeqN95kWSpGV+RLufg3fNU254DBtvPUZ5uW6M7XxgpT0GtJlvOj
+CwV3SPcl5XCsMBQgJeN/dVrlSPhOewMHBPqCYYdu8DvEpMfQ9XQ+pV0aCPKbJdL2rAQmPlU6Yiil
+e7Iwr/g3wtG61jj99O9JMDeZJiFIhQGp5Rbn3JBV3w/oOM2ZNyFPXfUib2rFEhZgF1XyZWampzCR
+OME4HYYEhLoaJXhena/MUGDWE4dS7WMfbWV9whUYdMrhfmQpjHLYFhN9C0lK8SgbIHRrxT3dsKpI
+CT0ugpTNGmXZK4iambwYfp/ufWZ8Pr2UuIHOzZgweMFvZ9C+X+Bo7d7iscksWXiSqt8rYGPy5V65
+48r6f1CGPqI0GAwJaCgRHOThuVw+R7oyPxjMW4T182t0xHJ04eOLoEq9jWYv6q012iDTiIJh8BIi
+trzQ1aTsr1SIJSQ8p22xcik/Plemf1WvbibG/ufMQFxRRIEKeN5KzlW/HdXZt1bv8Hb/C3m1r737
+qWmRRpdogBQ2HbN/uymYNqUg+oJgYjOk7Na6B6duxc8UpufWkjTYgfX8HV2qXB72o007uPc5AgMB
+AAGjgZcwgZQwDwYDVR0TAQH/BAUwAwEB/zBSBgNVHSAESzBJMEcGBFUdIAAwPzA9BggrBgEFBQcC
+ARYxaHR0cDovL3d3dy5wa2lvdmVyaGVpZC5ubC9wb2xpY2llcy9yb290LXBvbGljeS1HMjAOBgNV
+HQ8BAf8EBAMCAQYwHQYDVR0OBBYEFJFoMocVHYnitfGsNig0jQt8YojrMA0GCSqGSIb3DQEBCwUA
+A4ICAQCoQUpnKpKBglBu4dfYszk78wIVCVBR7y29JHuIhjv5tLySCZa59sCrI2AGeYwRTlHSeYAz
++51IvuxBQ4EffkdAHOV6CMqqi3WtFMTC6GY8ggen5ieCWxjmD27ZUD6KQhgpxrRW/FYQoAUXvQwj
+f/ST7ZwaUb7dRUG/kSS0H4zpX897IZmflZ85OkYcbPnNe5yQzSipx6lVu6xiNGI1E0sUOlWDuYaN
+kqbG9AclVMwWVxJKgnjIFNkXgiYtXSAfea7+1HAWFpWD2DU5/1JddRwWxRNVz0fMdWVSSt7wsKfk
+CpYL+63C4iWEst3kvX5ZbJvw8NjnyvLplzh+ib7M+zkXYT9y2zqR2GUBGR2tUKRXCnxLvJxxcypF
+URmFzI79R6d0lR2o0a9OF7FpJsKqeFdbxU2n5Z4FF5TKsl+gSRiNNOkmbEgeqmiSBeGCc1qb3Adb
+CG19ndeNIdn8FCCqwkXfP+cAslHkwvgFuXkajDTznlvkN1trSt8sV4pAWja63XVECDdCcAz+3F4h
+oKOKwJCcaNpQ5kUQR3i2TtJlycM33+FCY7BXN0Ute4qcvwXqZVUz9zkQxSgqIXobisQk+T8VyJoV
+IPVVYpbtbZNQvOSqeK3Zywplh6ZmwcSBo3c6WB4L7oOLnR7SUqTMHW+wmG2UMbX4cQrcufx9MmDm
+66+KAQ==
+-----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-----
+MIIDbTCCAlWgAwIBAgIBATANBgkqhkiG9w0BAQUFADBYMQswCQYDVQQGEwJKUDErMCkGA1UEChMi
+SmFwYW4gQ2VydGlmaWNhdGlvbiBTZXJ2aWNlcywgSW5jLjEcMBoGA1UEAxMTU2VjdXJlU2lnbiBS
+b290Q0ExMTAeFw0wOTA0MDgwNDU2NDdaFw0yOTA0MDgwNDU2NDdaMFgxCzAJBgNVBAYTAkpQMSsw
+KQYDVQQKEyJKYXBhbiBDZXJ0aWZpY2F0aW9uIFNlcnZpY2VzLCBJbmMuMRwwGgYDVQQDExNTZWN1
+cmVTaWduIFJvb3RDQTExMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA/XeqpRyQBTvL
+TJszi1oURaTnkBbR31fSIRCkF/3frNYfp+TbfPfs37gD2pRY/V1yfIw/XwFndBWW4wI8h9uuywGO
+wvNmxoVF9ALGOrVisq/6nL+k5tSAMJjzDbaTj6nU2DbysPyKyiyhFTOVMdrAG/LuYpmGYz+/3ZMq
+g6h2uRMft85OQoWPIucuGvKVCbIFtUROd6EgvanyTgp9UK31BQ1FT0Zx/Sg+U/sE2C3XZR1KG/rP
+O7AxmjVuyIsG0wCR8pQIZUyxNAYAeoni8McDWc/V1uinMrPmmECGxc0nEovMe863ETxiYAcjPitA
+bpSACW22s293bzUIUPsCh8U+iQIDAQABo0IwQDAdBgNVHQ4EFgQUW/hNT7KlhtQ60vFjmqC+CfZX
+t94wDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZIhvcNAQEFBQADggEBAKCh
+OBZmLqdWHyGcBvod7bkixTgm2E5P7KN/ed5GIaGHd48HCJqypMWvDzKYC3xmKbabfSVSSUOrTC4r
+bnpwrxYO4wJs+0LmGJ1F2FXI6Dvd5+H0LgscNFxsWEr7jIhQX5Ucv+2rIrVls4W6ng+4reV6G4pQ
+Oh29Dbx7VFALuUKvVaAYga1lme++5Jy/xIWrQbJUb9wlze144o4MjQlJ3WN7WmmWAiGovVJZ6X01
+y8hSyn+B/tlr0/cR7SXf+Of5pPpyl4RTDaXQMhhRdlkUbA/r7F+AjHVDg8OFmP9Mni0N5HeDk061
+lgeLKBObjBmNQSdJQO7e5iNEOdyhIta6A/I=
+-----END CERTIFICATE-----
+
+Microsec e-Szigno Root CA 2009
+==============================
+-----BEGIN CERTIFICATE-----
+MIIECjCCAvKgAwIBAgIJAMJ+QwRORz8ZMA0GCSqGSIb3DQEBCwUAMIGCMQswCQYDVQQGEwJIVTER
+MA8GA1UEBwwIQnVkYXBlc3QxFjAUBgNVBAoMDU1pY3Jvc2VjIEx0ZC4xJzAlBgNVBAMMHk1pY3Jv
+c2VjIGUtU3ppZ25vIFJvb3QgQ0EgMjAwOTEfMB0GCSqGSIb3DQEJARYQaW5mb0BlLXN6aWduby5o
+dTAeFw0wOTA2MTYxMTMwMThaFw0yOTEyMzAxMTMwMThaMIGCMQswCQYDVQQGEwJIVTERMA8GA1UE
+BwwIQnVkYXBlc3QxFjAUBgNVBAoMDU1pY3Jvc2VjIEx0ZC4xJzAlBgNVBAMMHk1pY3Jvc2VjIGUt
+U3ppZ25vIFJvb3QgQ0EgMjAwOTEfMB0GCSqGSIb3DQEJARYQaW5mb0BlLXN6aWduby5odTCCASIw
+DQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAOn4j/NjrdqG2KfgQvvPkd6mJviZpWNwrZuuyjNA
+fW2WbqEORO7hE52UQlKavXWFdCyoDh2Tthi3jCyoz/tccbna7P7ofo/kLx2yqHWH2Leh5TvPmUpG
+0IMZfcChEhyVbUr02MelTTMuhTlAdX4UfIASmFDHQWe4oIBhVKZsTh/gnQ4H6cm6M+f+wFUoLAKA
+pxn1ntxVUwOXewdI/5n7N4okxFnMUBBjjqqpGrCEGob5X7uxUG6k0QrM1XF+H6cbfPVTbiJfyyvm
+1HxdrtbCxkzlBQHZ7Vf8wSN5/PrIJIOV87VqUQHQd9bpEqH5GoP7ghu5sJf0dgYzQ0mg/wu1+rUC
+AwEAAaOBgDB+MA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMB0GA1UdDgQWBBTLD8bf
+QkPMPcu1SCOhGnqmKrs0aDAfBgNVHSMEGDAWgBTLD8bfQkPMPcu1SCOhGnqmKrs0aDAbBgNVHREE
+FDASgRBpbmZvQGUtc3ppZ25vLmh1MA0GCSqGSIb3DQEBCwUAA4IBAQDJ0Q5eLtXMs3w+y/w9/w0o
+lZMEyL/azXm4Q5DwpL7v8u8hmLzU1F0G9u5C7DBsoKqpyvGvivo/C3NqPuouQH4frlRheesuCDfX
+I/OMn74dseGkddug4lQUsbocKaQY9hK6ohQU4zE1yED/t+AFdlfBHFny+L/k7SViXITwfn4fs775
+tyERzAMBVnCnEJIeGzSBHq2cGsMEPO0CYdYeBvNfOofyK/FFh+U9rNHHV4S9a67c2Pm2G2JwCz02
+yULyMtd6YebS2z3PyKnJm9zbWETXbzivf3jTo60adbocwTZ8jx5tHMN1Rq41Bab2XD0h7lbwyYIi
+LXpUq3DDfSJlgnCW
+-----END CERTIFICATE-----
+
+GlobalSign Root CA - R3
+=======================
+-----BEGIN CERTIFICATE-----
+MIIDXzCCAkegAwIBAgILBAAAAAABIVhTCKIwDQYJKoZIhvcNAQELBQAwTDEgMB4GA1UECxMXR2xv
+YmFsU2lnbiBSb290IENBIC0gUjMxEzARBgNVBAoTCkdsb2JhbFNpZ24xEzARBgNVBAMTCkdsb2Jh
+bFNpZ24wHhcNMDkwMzE4MTAwMDAwWhcNMjkwMzE4MTAwMDAwWjBMMSAwHgYDVQQLExdHbG9iYWxT
+aWduIFJvb3QgQ0EgLSBSMzETMBEGA1UEChMKR2xvYmFsU2lnbjETMBEGA1UEAxMKR2xvYmFsU2ln
+bjCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAMwldpB5BngiFvXAg7aEyiie/QV2EcWt
+iHL8RgJDx7KKnQRfJMsuS+FggkbhUqsMgUdwbN1k0ev1LKMPgj0MK66X17YUhhB5uzsTgHeMCOFJ
+0mpiLx9e+pZo34knlTifBtc+ycsmWQ1z3rDI6SYOgxXG71uL0gRgykmmKPZpO/bLyCiR5Z2KYVc3
+rHQU3HTgOu5yLy6c+9C7v/U9AOEGM+iCK65TpjoWc4zdQQ4gOsC0p6Hpsk+QLjJg6VfLuQSSaGjl
+OCZgdbKfd/+RFO+uIEn8rUAVSNECMWEZXriX7613t2Saer9fwRPvm2L7DWzgVGkWqQPabumDk3F2
+xmmFghcCAwEAAaNCMEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYE
+FI/wS3+oLkUkrk1Q+mOai97i3Ru8MA0GCSqGSIb3DQEBCwUAA4IBAQBLQNvAUKr+yAzv95ZURUm7
+lgAJQayzE4aGKAczymvmdLm6AC2upArT9fHxD4q/c2dKg8dEe3jgr25sbwMpjjM5RcOO5LlXbKr8
+EpbsU8Yt5CRsuZRj+9xTaGdWPoO4zzUhw8lo/s7awlOqzJCK6fBdRoyV3XpYKBovHd7NADdBj+1E
+bddTKJd+82cEHhXXipa0095MJ6RMG3NzdvQXmcIfeg7jLQitChws/zyrVQ4PkX4268NXSb7hLi18
+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-----
+MIIF8TCCA9mgAwIBAgIQALC3WhZIX7/hy/WL1xnmfTANBgkqhkiG9w0BAQsFADA4MQswCQYDVQQG
+EwJFUzEUMBIGA1UECgwLSVpFTlBFIFMuQS4xEzARBgNVBAMMCkl6ZW5wZS5jb20wHhcNMDcxMjEz
+MTMwODI4WhcNMzcxMjEzMDgyNzI1WjA4MQswCQYDVQQGEwJFUzEUMBIGA1UECgwLSVpFTlBFIFMu
+QS4xEzARBgNVBAMMCkl6ZW5wZS5jb20wggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDJ
+03rKDx6sp4boFmVqscIbRTJxldn+EFvMr+eleQGPicPK8lVx93e+d5TzcqQsRNiekpsUOqHnJJAK
+ClaOxdgmlOHZSOEtPtoKct2jmRXagaKH9HtuJneJWK3W6wyyQXpzbm3benhB6QiIEn6HLmYRY2xU
++zydcsC8Lv/Ct90NduM61/e0aL6i9eOBbsFGb12N4E3GVFWJGjMxCrFXuaOKmMPsOzTFlUFpfnXC
+PCDFYbpRR6AgkJOhkEvzTnyFRVSa0QUmQbC1TR0zvsQDyCV8wXDbO/QJLVQnSKwv4cSsPsjLkkxT
+OTcj7NMB+eAJRE1NZMDhDVqHIrytG6P+JrUV86f8hBnp7KGItERphIPzidF0BqnMC9bC3ieFUCbK
+F7jJeodWLBoBHmy+E60QrLUk9TiRodZL2vG70t5HtfG8gfZZa88ZU+mNFctKy6lvROUbQc/hhqfK
+0GqfvEyNBjNaooXlkDWgYlwWTvDjovoDGrQscbNYLN57C9saD+veIR8GdwYDsMnvmfzAuU8Lhij+
+0rnq49qlw0dpEuDb8PYZi+17cNcC1u2HGCgsBCRMd+RIihrGO5rUD8r6ddIBQFqNeb+Lz0vPqhbB
+leStTIo+F5HUsWLlguWABKQDfo2/2n+iD5dPDNMN+9fR5XJ+HMh3/1uaD7euBUbl8agW7EekFwID
+AQABo4H2MIHzMIGwBgNVHREEgagwgaWBD2luZm9AaXplbnBlLmNvbaSBkTCBjjFHMEUGA1UECgw+
+SVpFTlBFIFMuQS4gLSBDSUYgQTAxMzM3MjYwLVJNZXJjLlZpdG9yaWEtR2FzdGVpeiBUMTA1NSBG
+NjIgUzgxQzBBBgNVBAkMOkF2ZGEgZGVsIE1lZGl0ZXJyYW5lbyBFdG9yYmlkZWEgMTQgLSAwMTAx
+MCBWaXRvcmlhLUdhc3RlaXowDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0O
+BBYEFB0cZQ6o8iV7tJHP5LGx5r1VdGwFMA0GCSqGSIb3DQEBCwUAA4ICAQB4pgwWSp9MiDrAyw6l
+Fn2fuUhfGI8NYjb2zRlrrKvV9pF9rnHzP7MOeIWblaQnIUdCSnxIOvVFfLMMjlF4rJUT3sb9fbga
+kEyrkgPH7UIBzg/YsfqikuFgba56awmqxinuaElnMIAkejEWOVt+8Rwu3WwJrfIxwYJOubv5vr8q
+hT/AQKM6WfxZSzwoJNu0FXWuDYi6LnPAvViH5ULy617uHjAimcs30cQhbIHsvm0m5hzkQiCeR7Cs
+g1lwLDXWrzY0tM07+DKo7+N4ifuNRSzanLh+QBxh5z6ikixL8s36mLYp//Pye6kfLqCTVyvehQP5
+aTfLnnhqBbTFMXiJ7HqnheG5ezzevh55hM6fcA5ZwjUukCox2eRFekGkLhObNA5me0mrZJfQRsN5
+nXJQY6aYWwa9SG3YOYNw6DXwBdGqvOPbyALqfP2C2sJbUjWumDqtujWTI6cfSN01RpiyEGjkpTHC
+ClguGYEQyVB1/OpaFs4R1+7vUIgtYf8/QnMFlEPVjjxOAToZpR9GTnfQXeWBIiGH/pR9hNiTrdZo
+Q0iy2+tzJOeRf1SktoA+naM8THLCV8Sg1Mw4J87VBp6iSNnpn86CcDaTmjvfliHjWbcM2pE38P1Z
+WrOZyGlsQyYBNWNgVYkDOnXYukrZVP/u3oDYLdE41V4tC5h9Pmzb/CaIxw==
+-----END CERTIFICATE-----
+
+Chambers of Commerce Root - 2008
+================================
+-----BEGIN CERTIFICATE-----
+MIIHTzCCBTegAwIBAgIJAKPaQn6ksa7aMA0GCSqGSIb3DQEBBQUAMIGuMQswCQYDVQQGEwJFVTFD
+MEEGA1UEBxM6TWFkcmlkIChzZWUgY3VycmVudCBhZGRyZXNzIGF0IHd3dy5jYW1lcmZpcm1hLmNv
+bS9hZGRyZXNzKTESMBAGA1UEBRMJQTgyNzQzMjg3MRswGQYDVQQKExJBQyBDYW1lcmZpcm1hIFMu
+QS4xKTAnBgNVBAMTIENoYW1iZXJzIG9mIENvbW1lcmNlIFJvb3QgLSAyMDA4MB4XDTA4MDgwMTEy
+Mjk1MFoXDTM4MDczMTEyMjk1MFowga4xCzAJBgNVBAYTAkVVMUMwQQYDVQQHEzpNYWRyaWQgKHNl
+ZSBjdXJyZW50IGFkZHJlc3MgYXQgd3d3LmNhbWVyZmlybWEuY29tL2FkZHJlc3MpMRIwEAYDVQQF
+EwlBODI3NDMyODcxGzAZBgNVBAoTEkFDIENhbWVyZmlybWEgUy5BLjEpMCcGA1UEAxMgQ2hhbWJl
+cnMgb2YgQ29tbWVyY2UgUm9vdCAtIDIwMDgwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoIC
+AQCvAMtwNyuAWko6bHiUfaN/Gh/2NdW928sNRHI+JrKQUrpjOyhYb6WzbZSm891kDFX29ufyIiKA
+XuFixrYp4YFs8r/lfTJqVKAyGVn+H4vXPWCGhSRv4xGzdz4gljUha7MI2XAuZPeEklPWDrCQiorj
+h40G072QDuKZoRuGDtqaCrsLYVAGUvGef3bsyw/QHg3PmTA9HMRFEFis1tPo1+XqxQEHd9ZR5gN/
+ikilTWh1uem8nk4ZcfUyS5xtYBkL+8ydddy/Js2Pk3g5eXNeJQ7KXOt3EgfLZEFHcpOrUMPrCXZk
+NNI5t3YRCQ12RcSprj1qr7V9ZS+UWBDsXHyvfuK2GNnQm05aSd+pZgvMPMZ4fKecHePOjlO+Bd5g
+D2vlGts/4+EhySnB8esHnFIbAURRPHsl18TlUlRdJQfKFiC4reRB7noI/plvg6aRArBsNlVq5331
+lubKgdaX8ZSD6e2wsWsSaR6s+12pxZjptFtYer49okQ6Y1nUCyXeG0+95QGezdIp1Z8XGQpvvwyQ
+0wlf2eOKNcx5Wk0ZN5K3xMGtr/R5JJqyAQuxr1yW84Ay+1w9mPGgP0revq+ULtlVmhduYJ1jbLhj
+ya6BXBg14JC7vjxPNyK5fuvPnnchpj04gftI2jE9K+OJ9dC1vX7gUMQSibMjmhAxhduub+84Mxh2
+EQIDAQABo4IBbDCCAWgwEgYDVR0TAQH/BAgwBgEB/wIBDDAdBgNVHQ4EFgQU+SSsD7K1+HnA+mCI
+G8TZTQKeFxkwgeMGA1UdIwSB2zCB2IAU+SSsD7K1+HnA+mCIG8TZTQKeFxmhgbSkgbEwga4xCzAJ
+BgNVBAYTAkVVMUMwQQYDVQQHEzpNYWRyaWQgKHNlZSBjdXJyZW50IGFkZHJlc3MgYXQgd3d3LmNh
+bWVyZmlybWEuY29tL2FkZHJlc3MpMRIwEAYDVQQFEwlBODI3NDMyODcxGzAZBgNVBAoTEkFDIENh
+bWVyZmlybWEgUy5BLjEpMCcGA1UEAxMgQ2hhbWJlcnMgb2YgQ29tbWVyY2UgUm9vdCAtIDIwMDiC
+CQCj2kJ+pLGu2jAOBgNVHQ8BAf8EBAMCAQYwPQYDVR0gBDYwNDAyBgRVHSAAMCowKAYIKwYBBQUH
+AgEWHGh0dHA6Ly9wb2xpY3kuY2FtZXJmaXJtYS5jb20wDQYJKoZIhvcNAQEFBQADggIBAJASryI1
+wqM58C7e6bXpeHxIvj99RZJe6dqxGfwWPJ+0W2aeaufDuV2I6A+tzyMP3iU6XsxPpcG1Lawk0lgH
+3qLPaYRgM+gQDROpI9CF5Y57pp49chNyM/WqfcZjHwj0/gF/JM8rLFQJ3uIrbZLGOU8W6jx+ekbU
+RWpGqOt1glanq6B8aBMz9p0w8G8nOSQjKpD9kCk18pPfNKXG9/jvjA9iSnyu0/VU+I22mlaHFoI6
+M6taIgj3grrqLuBHmrS1RaMFO9ncLkVAO+rcf+g769HsJtg1pDDFOqxXnrN2pSB7+R5KBWIBpih1
+YJeSDW4+TTdDDZIVnBgizVGZoCkaPF+KMjNbMMeJL0eYD6MDxvbxrN8y8NmBGuScvfaAFPDRLLmF
+9dijscilIeUcE5fuDr3fKanvNFNb0+RqE4QGtjICxFKuItLcsiFCGtpA8CnJ7AoMXOLQusxI0zcK
+zBIKinmwPQN/aUv0NCB9szTqjktk9T79syNnFQ0EuPAtwQlRPLJsFfClI9eDdOTlLsn+mCdCxqvG
+nrDQWzilm1DefhiYtUU79nm06PcaewaD+9CL2rvHvRirCG88gGtAPxkZumWK5r7VXNM21+9AUiRg
+OGcEMeyP84LG3rlV8zsxkVrctQgVrXYlCg17LofiDKYGvCYQbTed7N14jHyAxfDZd0jQ
+-----END CERTIFICATE-----
+
+Global Chambersign Root - 2008
+==============================
+-----BEGIN CERTIFICATE-----
+MIIHSTCCBTGgAwIBAgIJAMnN0+nVfSPOMA0GCSqGSIb3DQEBBQUAMIGsMQswCQYDVQQGEwJFVTFD
+MEEGA1UEBxM6TWFkcmlkIChzZWUgY3VycmVudCBhZGRyZXNzIGF0IHd3dy5jYW1lcmZpcm1hLmNv
+bS9hZGRyZXNzKTESMBAGA1UEBRMJQTgyNzQzMjg3MRswGQYDVQQKExJBQyBDYW1lcmZpcm1hIFMu
+QS4xJzAlBgNVBAMTHkdsb2JhbCBDaGFtYmVyc2lnbiBSb290IC0gMjAwODAeFw0wODA4MDExMjMx
+NDBaFw0zODA3MzExMjMxNDBaMIGsMQswCQYDVQQGEwJFVTFDMEEGA1UEBxM6TWFkcmlkIChzZWUg
+Y3VycmVudCBhZGRyZXNzIGF0IHd3dy5jYW1lcmZpcm1hLmNvbS9hZGRyZXNzKTESMBAGA1UEBRMJ
+QTgyNzQzMjg3MRswGQYDVQQKExJBQyBDYW1lcmZpcm1hIFMuQS4xJzAlBgNVBAMTHkdsb2JhbCBD
+aGFtYmVyc2lnbiBSb290IC0gMjAwODCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAMDf
+VtPkOpt2RbQT2//BthmLN0EYlVJH6xedKYiONWwGMi5HYvNJBL99RDaxccy9Wglz1dmFRP+RVyXf
+XjaOcNFccUMd2drvXNL7G706tcuto8xEpw2uIRU/uXpbknXYpBI4iRmKt4DS4jJvVpyR1ogQC7N0
+ZJJ0YPP2zxhPYLIj0Mc7zmFLmY/CDNBAspjcDahOo7kKrmCgrUVSY7pmvWjg+b4aqIG7HkF4ddPB
+/gBVsIdU6CeQNR1MM62X/JcumIS/LMmjv9GYERTtY/jKmIhYF5ntRQOXfjyGHoiMvvKRhI9lNNgA
+TH23MRdaKXoKGCQwoze1eqkBfSbW+Q6OWfH9GzO1KTsXO0G2Id3UwD2ln58fQ1DJu7xsepeY7s2M
+H/ucUa6LcL0nn3HAa6x9kGbo1106DbDVwo3VyJ2dwW3Q0L9R5OP4wzg2rtandeavhENdk5IMagfe
+Ox2YItaswTXbo6Al/3K1dh3ebeksZixShNBFks4c5eUzHdwHU1SjqoI7mjcv3N2gZOnm3b2u/GSF
+HTynyQbehP9r6GsaPMWis0L7iwk+XwhSx2LE1AVxv8Rk5Pihg+g+EpuoHtQ2TS9x9o0o9oOpE9Jh
+wZG7SMA0j0GMS0zbaRL/UJScIINZc+18ofLx/d33SdNDWKBWY8o9PeU1VlnpDsogzCtLkykPAgMB
+AAGjggFqMIIBZjASBgNVHRMBAf8ECDAGAQH/AgEMMB0GA1UdDgQWBBS5CcqcHtvTbDprru1U8VuT
+BjUuXjCB4QYDVR0jBIHZMIHWgBS5CcqcHtvTbDprru1U8VuTBjUuXqGBsqSBrzCBrDELMAkGA1UE
+BhMCRVUxQzBBBgNVBAcTOk1hZHJpZCAoc2VlIGN1cnJlbnQgYWRkcmVzcyBhdCB3d3cuY2FtZXJm
+aXJtYS5jb20vYWRkcmVzcykxEjAQBgNVBAUTCUE4Mjc0MzI4NzEbMBkGA1UEChMSQUMgQ2FtZXJm
+aXJtYSBTLkEuMScwJQYDVQQDEx5HbG9iYWwgQ2hhbWJlcnNpZ24gUm9vdCAtIDIwMDiCCQDJzdPp
+1X0jzjAOBgNVHQ8BAf8EBAMCAQYwPQYDVR0gBDYwNDAyBgRVHSAAMCowKAYIKwYBBQUHAgEWHGh0
+dHA6Ly9wb2xpY3kuY2FtZXJmaXJtYS5jb20wDQYJKoZIhvcNAQEFBQADggIBAICIf3DekijZBZRG
+/5BXqfEv3xoNa/p8DhxJJHkn2EaqbylZUohwEurdPfWbU1Rv4WCiqAm57OtZfMY18dwY6fFn5a+6
+ReAJ3spED8IXDneRRXozX1+WLGiLwUePmJs9wOzL9dWCkoQ10b42OFZyMVtHLaoXpGNR6woBrX/s
+dZ7LoR/xfxKxueRkf2fWIyr0uDldmOghp+G9PUIadJpwr2hsUF1Jz//7Dl3mLEfXgTpZALVza2Mg
+9jFFCDkO9HB+QHBaP9BrQql0PSgvAm11cpUJjUhjxsYjV5KTXjXBjfkK9yydYhz2rXzdpjEetrHH
+foUm+qRqtdpjMNHvkzeyZi99Bffnt0uYlDXA2TopwZ2yUDMdSqlapskD7+3056huirRXhOukP9Du
+qqqHW2Pok+JrqNS4cnhrG+055F3Lm6qH1U9OAP7Zap88MQ8oAgF9mOinsKJknnn4SPIVqczmyETr
+P3iZ8ntxPjzxmKfFGBI/5rsoM0LpRQp8bfKGeS/Fghl9CYl8slR2iK7ewfPM4W7bMdaTrpmg7yVq
+c5iJWzouE4gev8CSlDQb4ye3ix5vQv/n6TebUB0tovkC7stYWDpxvGjjqsGvHCgfotwjZT+B6q6Z
+09gwzxMNTxXJhLynSC34MCN32EZLeW32jO06f2ARePTpm67VVMB0gNELQp/B
+-----END CERTIFICATE-----
+
+Go Daddy Root Certificate Authority - G2
+========================================
+-----BEGIN CERTIFICATE-----
+MIIDxTCCAq2gAwIBAgIBADANBgkqhkiG9w0BAQsFADCBgzELMAkGA1UEBhMCVVMxEDAOBgNVBAgT
+B0FyaXpvbmExEzARBgNVBAcTClNjb3R0c2RhbGUxGjAYBgNVBAoTEUdvRGFkZHkuY29tLCBJbmMu
+MTEwLwYDVQQDEyhHbyBEYWRkeSBSb290IENlcnRpZmljYXRlIEF1dGhvcml0eSAtIEcyMB4XDTA5
+MDkwMTAwMDAwMFoXDTM3MTIzMTIzNTk1OVowgYMxCzAJBgNVBAYTAlVTMRAwDgYDVQQIEwdBcml6
+b25hMRMwEQYDVQQHEwpTY290dHNkYWxlMRowGAYDVQQKExFHb0RhZGR5LmNvbSwgSW5jLjExMC8G
+A1UEAxMoR28gRGFkZHkgUm9vdCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkgLSBHMjCCASIwDQYJKoZI
+hvcNAQEBBQADggEPADCCAQoCggEBAL9xYgjx+lk09xvJGKP3gElY6SKDE6bFIEMBO4Tx5oVJnyfq
+9oQbTqC023CYxzIBsQU+B07u9PpPL1kwIuerGVZr4oAH/PMWdYA5UXvl+TW2dE6pjYIT5LY/qQOD
++qK+ihVqf94Lw7YZFAXK6sOoBJQ7RnwyDfMAZiLIjWltNowRGLfTshxgtDj6AozO091GB94KPutd
+fMh8+7ArU6SSYmlRJQVhGkSBjCypQ5Yj36w6gZoOKcUcqeldHraenjAKOc7xiID7S13MMuyFYkMl
+NAJWJwGRtDtwKj9useiciAF9n9T521NtYJ2/LOdYq7hfRvzOxBsDPAnrSTFcaUaz4EcCAwEAAaNC
+MEAwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0OBBYEFDqahQcQZyi27/a9
+BUFuIMGU2g/eMA0GCSqGSIb3DQEBCwUAA4IBAQCZ21151fmXWWcDYfF+OwYxdS2hII5PZYe096ac
+vNjpL9DbWu7PdIxztDhC2gV7+AJ1uP2lsdeu9tfeE8tTEH6KRtGX+rcuKxGrkLAngPnon1rpN5+r
+5N9ss4UXnT3ZJE95kTXWXwTrgIOrmgIttRD02JDHBHNA7XIloKmf7J6raBKZV8aPEjoJpL1E/QYV
+N8Gb5DKj7Tjo2GTzLH4U/ALqn83/B2gX2yKQOC16jdFU8WnjXzPKej17CuPKf1855eJ1usV2GDPO
+LPAvTK33sefOT6jEm0pUBsV/fdUID+Ic/n4XuKxe9tQWskMJDE32p2u0mYRlynqI4uJEvlz36hz1
+-----END CERTIFICATE-----
+
+Starfield Root Certificate Authority - G2
+=========================================
+-----BEGIN CERTIFICATE-----
+MIID3TCCAsWgAwIBAgIBADANBgkqhkiG9w0BAQsFADCBjzELMAkGA1UEBhMCVVMxEDAOBgNVBAgT
+B0FyaXpvbmExEzARBgNVBAcTClNjb3R0c2RhbGUxJTAjBgNVBAoTHFN0YXJmaWVsZCBUZWNobm9s
+b2dpZXMsIEluYy4xMjAwBgNVBAMTKVN0YXJmaWVsZCBSb290IENlcnRpZmljYXRlIEF1dGhvcml0
+eSAtIEcyMB4XDTA5MDkwMTAwMDAwMFoXDTM3MTIzMTIzNTk1OVowgY8xCzAJBgNVBAYTAlVTMRAw
+DgYDVQQIEwdBcml6b25hMRMwEQYDVQQHEwpTY290dHNkYWxlMSUwIwYDVQQKExxTdGFyZmllbGQg
+VGVjaG5vbG9naWVzLCBJbmMuMTIwMAYDVQQDEylTdGFyZmllbGQgUm9vdCBDZXJ0aWZpY2F0ZSBB
+dXRob3JpdHkgLSBHMjCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAL3twQP89o/8ArFv
+W59I2Z154qK3A2FWGMNHttfKPTUuiUP3oWmb3ooa/RMgnLRJdzIpVv257IzdIvpy3Cdhl+72WoTs
+bhm5iSzchFvVdPtrX8WJpRBSiUZV9Lh1HOZ/5FSuS/hVclcCGfgXcVnrHigHdMWdSL5stPSksPNk
+N3mSwOxGXn/hbVNMYq/NHwtjuzqd+/x5AJhhdM8mgkBj87JyahkNmcrUDnXMN/uLicFZ8WJ/X7Nf
+ZTD4p7dNdloedl40wOiWVpmKs/B/pM293DIxfJHP4F8R+GuqSVzRmZTRouNjWwl2tVZi4Ut0HZbU
+JtQIBFnQmA4O5t78w+wfkPECAwEAAaNCMEAwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMC
+AQYwHQYDVR0OBBYEFHwMMh+n2TB/xH1oo2Kooc6rB1snMA0GCSqGSIb3DQEBCwUAA4IBAQARWfol
+TwNvlJk7mh+ChTnUdgWUXuEok21iXQnCoKjUsHU48TRqneSfioYmUeYs0cYtbpUgSpIB7LiKZ3sx
+4mcujJUDJi5DnUox9g61DLu34jd/IroAow57UvtruzvE03lRTs2Q9GcHGcg8RnoNAX3FWOdt5oUw
+F5okxBDgBPfg8n/Uqgr/Qh037ZTlZFkSIHc40zI+OIF1lnP6aI+xy84fxez6nH7PfrHxBy22/L/K
+pL/QlwVKvOoYKAKQvVR4CSFx09F9HdkWsKlhPdAKACL8x3vLCWRFCztAgfd9fDL1mMpYjn0q7pBZ
+c2T5NnReJaH1ZgUufzkVqSr7UIuOhWn0
+-----END CERTIFICATE-----
+
+Starfield Services Root Certificate Authority - G2
+==================================================
+-----BEGIN CERTIFICATE-----
+MIID7zCCAtegAwIBAgIBADANBgkqhkiG9w0BAQsFADCBmDELMAkGA1UEBhMCVVMxEDAOBgNVBAgT
+B0FyaXpvbmExEzARBgNVBAcTClNjb3R0c2RhbGUxJTAjBgNVBAoTHFN0YXJmaWVsZCBUZWNobm9s
+b2dpZXMsIEluYy4xOzA5BgNVBAMTMlN0YXJmaWVsZCBTZXJ2aWNlcyBSb290IENlcnRpZmljYXRl
+IEF1dGhvcml0eSAtIEcyMB4XDTA5MDkwMTAwMDAwMFoXDTM3MTIzMTIzNTk1OVowgZgxCzAJBgNV
+BAYTAlVTMRAwDgYDVQQIEwdBcml6b25hMRMwEQYDVQQHEwpTY290dHNkYWxlMSUwIwYDVQQKExxT
+dGFyZmllbGQgVGVjaG5vbG9naWVzLCBJbmMuMTswOQYDVQQDEzJTdGFyZmllbGQgU2VydmljZXMg
+Um9vdCBDZXJ0aWZpY2F0ZSBBdXRob3JpdHkgLSBHMjCCASIwDQYJKoZIhvcNAQEBBQADggEPADCC
+AQoCggEBANUMOsQq+U7i9b4Zl1+OiFOxHz/Lz58gE20pOsgPfTz3a3Y4Y9k2YKibXlwAgLIvWX/2
+h/klQ4bnaRtSmpDhcePYLQ1Ob/bISdm28xpWriu2dBTrz/sm4xq6HZYuajtYlIlHVv8loJNwU4Pa
+hHQUw2eeBGg6345AWh1KTs9DkTvnVtYAcMtS7nt9rjrnvDH5RfbCYM8TWQIrgMw0R9+53pBlbQLP
+LJGmpufehRhJfGZOozptqbXuNC66DQO4M99H67FrjSXZm86B0UVGMpZwh94CDklDhbZsc7tk6mFB
+rMnUVN+HL8cisibMn1lUaJ/8viovxFUcdUBgF4UCVTmLfwUCAwEAAaNCMEAwDwYDVR0TAQH/BAUw
+AwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0OBBYEFJxfAN+qAdcwKziIorhtSpzyEZGDMA0GCSqG
+SIb3DQEBCwUAA4IBAQBLNqaEd2ndOxmfZyMIbw5hyf2E3F/YNoHN2BtBLZ9g3ccaaNnRbobhiCPP
+E95Dz+I0swSdHynVv/heyNXBve6SbzJ08pGCL72CQnqtKrcgfU28elUSwhXqvfdqlS5sdJ/PHLTy
+xQGjhdByPq1zqwubdQxtRbeOlKyWN7Wg0I8VRw7j6IPdj/3vQQF3zCepYoUz8jcI73HPdwbeyBkd
+iEDPfUYd/x7H4c7/I9vG+o1VTqkC50cRRj70/b17KSa7qWFiNyi2LSr2EIZkyXCn0q23KXB56jza
+YyWf/Wi3MOxw+3WKt21gZ7IeyLnp2KhvAotnDU0mV3HaIPzBSlCNsSi6
+-----END CERTIFICATE-----
+
+AffirmTrust Commercial
+======================
+-----BEGIN CERTIFICATE-----
+MIIDTDCCAjSgAwIBAgIId3cGJyapsXwwDQYJKoZIhvcNAQELBQAwRDELMAkGA1UEBhMCVVMxFDAS
+BgNVBAoMC0FmZmlybVRydXN0MR8wHQYDVQQDDBZBZmZpcm1UcnVzdCBDb21tZXJjaWFsMB4XDTEw
+MDEyOTE0MDYwNloXDTMwMTIzMTE0MDYwNlowRDELMAkGA1UEBhMCVVMxFDASBgNVBAoMC0FmZmly
+bVRydXN0MR8wHQYDVQQDDBZBZmZpcm1UcnVzdCBDb21tZXJjaWFsMIIBIjANBgkqhkiG9w0BAQEF
+AAOCAQ8AMIIBCgKCAQEA9htPZwcroRX1BiLLHwGy43NFBkRJLLtJJRTWzsO3qyxPxkEylFf6Eqdb
+DuKPHx6GGaeqtS25Xw2Kwq+FNXkyLbscYjfysVtKPcrNcV/pQr6U6Mje+SJIZMblq8Yrba0F8PrV
+C8+a5fBQpIs7R6UjW3p6+DM/uO+Zl+MgwdYoic+U+7lF7eNAFxHUdPALMeIrJmqbTFeurCA+ukV6
+BfO9m2kVrn1OIGPENXY6BwLJN/3HR+7o8XYdcxXyl6S1yHp52UKqK39c/s4mT6NmgTWvRLpUHhww
+MmWd5jyTXlBOeuM61G7MGvv50jeuJCqrVwMiKA1JdX+3KNp1v47j3A55MQIDAQABo0IwQDAdBgNV
+HQ4EFgQUnZPGU4teyq8/nx4P5ZmVvCT2lI8wDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMC
+AQYwDQYJKoZIhvcNAQELBQADggEBAFis9AQOzcAN/wr91LoWXym9e2iZWEnStB03TX8nfUYGXUPG
+hi4+c7ImfU+TqbbEKpqrIZcUsd6M06uJFdhrJNTxFq7YpFzUf1GO7RgBsZNjvbz4YYCanrHOQnDi
+qX0GJX0nof5v7LMeJNrjS1UaADs1tDvZ110w/YETifLCBivtZ8SOyUOyXGsViQK8YvxO8rUzqrJv
+0wqiUOP2O+guRMLbZjipM1ZI8W0bM40NjD9gN53Tym1+NH4Nn3J2ixufcv1SNUFFApYvHLKac0kh
+sUlHRUe072o0EclNmsxZt9YCnlpOZbWUrhvfKbAW8b8Angc6F2S1BLUjIZkKlTuXfO8=
+-----END CERTIFICATE-----
+
+AffirmTrust Networking
+======================
+-----BEGIN CERTIFICATE-----
+MIIDTDCCAjSgAwIBAgIIfE8EORzUmS0wDQYJKoZIhvcNAQEFBQAwRDELMAkGA1UEBhMCVVMxFDAS
+BgNVBAoMC0FmZmlybVRydXN0MR8wHQYDVQQDDBZBZmZpcm1UcnVzdCBOZXR3b3JraW5nMB4XDTEw
+MDEyOTE0MDgyNFoXDTMwMTIzMTE0MDgyNFowRDELMAkGA1UEBhMCVVMxFDASBgNVBAoMC0FmZmly
+bVRydXN0MR8wHQYDVQQDDBZBZmZpcm1UcnVzdCBOZXR3b3JraW5nMIIBIjANBgkqhkiG9w0BAQEF
+AAOCAQ8AMIIBCgKCAQEAtITMMxcua5Rsa2FSoOujz3mUTOWUgJnLVWREZY9nZOIG41w3SfYvm4SE
+Hi3yYJ0wTsyEheIszx6e/jarM3c1RNg1lho9Nuh6DtjVR6FqaYvZ/Ls6rnla1fTWcbuakCNrmreI
+dIcMHl+5ni36q1Mr3Lt2PpNMCAiMHqIjHNRqrSK6mQEubWXLviRmVSRLQESxG9fhwoXA3hA/Pe24
+/PHxI1Pcv2WXb9n5QHGNfb2V1M6+oF4nI979ptAmDgAp6zxG8D1gvz9Q0twmQVGeFDdCBKNwV6gb
+h+0t+nvujArjqWaJGctB+d1ENmHP4ndGyH329JKBNv3bNPFyfvMMFr20FQIDAQABo0IwQDAdBgNV
+HQ4EFgQUBx/S55zawm6iQLSwelAQUHTEyL0wDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMC
+AQYwDQYJKoZIhvcNAQEFBQADggEBAIlXshZ6qML91tmbmzTCnLQyFE2npN/svqe++EPbkTfOtDIu
+UFUaNU52Q3Eg75N3ThVwLofDwR1t3Mu1J9QsVtFSUzpE0nPIxBsFZVpikpzuQY0x2+c06lkh1QF6
+12S4ZDnNye2v7UsDSKegmQGA3GWjNq5lWUhPgkvIZfFXHeVZLgo/bNjR9eUJtGxUAArgFU2HdW23
+WJZa3W3SAKD0m0i+wzekujbgfIeFlxoVot4uolu9rxj5kFDNcFn4J2dHy8egBzp90SxdbBk6ZrV9
+/ZFvgrG+CJPbFEfxojfHRZ48x3evZKiT3/Zpg4Jg8klCNO1aAFSFHBY2kgxc+qatv9s=
+-----END CERTIFICATE-----
+
+AffirmTrust Premium
+===================
+-----BEGIN CERTIFICATE-----
+MIIFRjCCAy6gAwIBAgIIbYwURrGmCu4wDQYJKoZIhvcNAQEMBQAwQTELMAkGA1UEBhMCVVMxFDAS
+BgNVBAoMC0FmZmlybVRydXN0MRwwGgYDVQQDDBNBZmZpcm1UcnVzdCBQcmVtaXVtMB4XDTEwMDEy
+OTE0MTAzNloXDTQwMTIzMTE0MTAzNlowQTELMAkGA1UEBhMCVVMxFDASBgNVBAoMC0FmZmlybVRy
+dXN0MRwwGgYDVQQDDBNBZmZpcm1UcnVzdCBQcmVtaXVtMIICIjANBgkqhkiG9w0BAQEFAAOCAg8A
+MIICCgKCAgEAxBLfqV/+Qd3d9Z+K4/as4Tx4mrzY8H96oDMq3I0gW64tb+eT2TZwamjPjlGjhVtn
+BKAQJG9dKILBl1fYSCkTtuG+kU3fhQxTGJoeJKJPj/CihQvL9Cl/0qRY7iZNyaqoe5rZ+jjeRFcV
+5fiMyNlI4g0WJx0eyIOFJbe6qlVBzAMiSy2RjYvmia9mx+n/K+k8rNrSs8PhaJyJ+HoAVt70VZVs
++7pk3WKL3wt3MutizCaam7uqYoNMtAZ6MMgpv+0GTZe5HMQxK9VfvFMSF5yZVylmd2EhMQcuJUmd
+GPLu8ytxjLW6OQdJd/zvLpKQBY0tL3d770O/Nbua2Plzpyzy0FfuKE4mX4+QaAkvuPjcBukumj5R
+p9EixAqnOEhss/n/fauGV+O61oV4d7pD6kh/9ti+I20ev9E2bFhc8e6kGVQa9QPSdubhjL08s9NI
+S+LI+H+SqHZGnEJlPqQewQcDWkYtuJfzt9WyVSHvutxMAJf7FJUnM7/oQ0dG0giZFmA7mn7S5u04
+6uwBHjxIVkkJx0w3AJ6IDsBz4W9m6XJHMD4Q5QsDyZpCAGzFlH5hxIrff4IaC1nEWTJ3s7xgaVY5
+/bQGeyzWZDbZvUjthB9+pSKPKrhC9IK31FOQeE4tGv2Bb0TXOwF0lkLgAOIua+rF7nKsu7/+6qqo
++Nz2snmKtmcCAwEAAaNCMEAwHQYDVR0OBBYEFJ3AZ6YMItkm9UWrpmVSESfYRaxjMA8GA1UdEwEB
+/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMA0GCSqGSIb3DQEBDAUAA4ICAQCzV00QYk465KzquByv
+MiPIs0laUZx2KI15qldGF9X1Uva3ROgIRL8YhNILgM3FEv0AVQVhh0HctSSePMTYyPtwni94loMg
+Nt58D2kTiKV1NpgIpsbfrM7jWNa3Pt668+s0QNiigfV4Py/VpfzZotReBA4Xrf5B8OWycvpEgjNC
+6C1Y91aMYj+6QrCcDFx+LmUmXFNPALJ4fqENmS2NuB2OosSw/WDQMKSOyARiqcTtNd56l+0OOF6S
+L5Nwpamcb6d9Ex1+xghIsV5n61EIJenmJWtSKZGc0jlzCFfemQa0W50QBuHCAKi4HEoCChTQwUHK
++4w1IX2COPKpVJEZNZOUbWo6xbLQu4mGk+ibyQ86p3q4ofB4Rvr8Ny/lioTz3/4E2aFooC8k4gmV
+BtWVyuEklut89pMFu+1z6S3RdTnX5yTb2E5fQ4+e0BQ5v1VwSJlXMbSc7kqYA5YwH2AG7hsj/oFg
+IxpHYoWlzBk0gG+zrBrjn/B7SK3VAdlntqlyk+otZrWyuOQ9PLLvTIzq6we/qzWaVYa8GKa1qF60
+g2xraUDTn9zxw2lrueFtCfTxqlB2Cnp9ehehVZZCmTEJ3WARjQUwfuaORtGdFNrHF+QFlozEJLUb
+zxQHskD4o55BhrwE0GuWyCqANP2/7waj3VjFhT0+j/6eKeC2uAloGRwYQw==
+-----END CERTIFICATE-----
+
+AffirmTrust Premium ECC
+=======================
+-----BEGIN CERTIFICATE-----
+MIIB/jCCAYWgAwIBAgIIdJclisc/elQwCgYIKoZIzj0EAwMwRTELMAkGA1UEBhMCVVMxFDASBgNV
+BAoMC0FmZmlybVRydXN0MSAwHgYDVQQDDBdBZmZpcm1UcnVzdCBQcmVtaXVtIEVDQzAeFw0xMDAx
+MjkxNDIwMjRaFw00MDEyMzExNDIwMjRaMEUxCzAJBgNVBAYTAlVTMRQwEgYDVQQKDAtBZmZpcm1U
+cnVzdDEgMB4GA1UEAwwXQWZmaXJtVHJ1c3QgUHJlbWl1bSBFQ0MwdjAQBgcqhkjOPQIBBgUrgQQA
+IgNiAAQNMF4bFZ0D0KF5Nbc6PJJ6yhUczWLznCZcBz3lVPqj1swS6vQUX+iOGasvLkjmrBhDeKzQ
+N8O9ss0s5kfiGuZjuD0uL3jET9v0D6RoTFVya5UdThhClXjMNzyR4ptlKymjQjBAMB0GA1UdDgQW
+BBSaryl6wBE1NSZRMADDav5A1a7WPDAPBgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBBjAK
+BggqhkjOPQQDAwNnADBkAjAXCfOHiFBar8jAQr9HX/VsaobgxCd05DhT1wV/GzTjxi+zygk8N53X
+57hG8f2h4nECMEJZh0PUUd+60wkyWs6Iflc9nF9Ca/UHLbXwgpP5WW+uZPpY5Yse42O+tYHNbwKM
+eQ==
+-----END CERTIFICATE-----
+
+Certum Trusted Network CA
+=========================
+-----BEGIN CERTIFICATE-----
+MIIDuzCCAqOgAwIBAgIDBETAMA0GCSqGSIb3DQEBBQUAMH4xCzAJBgNVBAYTAlBMMSIwIAYDVQQK
+ExlVbml6ZXRvIFRlY2hub2xvZ2llcyBTLkEuMScwJQYDVQQLEx5DZXJ0dW0gQ2VydGlmaWNhdGlv
+biBBdXRob3JpdHkxIjAgBgNVBAMTGUNlcnR1bSBUcnVzdGVkIE5ldHdvcmsgQ0EwHhcNMDgxMDIy
+MTIwNzM3WhcNMjkxMjMxMTIwNzM3WjB+MQswCQYDVQQGEwJQTDEiMCAGA1UEChMZVW5pemV0byBU
+ZWNobm9sb2dpZXMgUy5BLjEnMCUGA1UECxMeQ2VydHVtIENlcnRpZmljYXRpb24gQXV0aG9yaXR5
+MSIwIAYDVQQDExlDZXJ0dW0gVHJ1c3RlZCBOZXR3b3JrIENBMIIBIjANBgkqhkiG9w0BAQEFAAOC
+AQ8AMIIBCgKCAQEA4/t9o3K6wvDJFIf1awFO4W5AB7ptJ11/91sts1rHUV+rpDKmYYe2bg+G0jAC
+l/jXaVehGDldamR5xgFZrDwxSjh80gTSSyjoIF87B6LMTXPb865Px1bVWqeWifrzq2jUI4ZZJ88J
+J7ysbnKDHDBy3+Ci6dLhdHUZvSqeexVUBBvXQzmtVSjF4hq79MDkrjhJM8x2hZ85RdKknvISjFH4
+fOQtf/WsX+sWn7Et0brMkUJ3TCXJkDhv2/DM+44el1k+1WBO5gUo7Ul5E0u6SNsv+XLTOcr+H9g0
+cvW0QM8xAcPs3hEtF10fuFDRXhmnad4HMyjKUJX5p1TLVIZQRan5SQIDAQABo0IwQDAPBgNVHRMB
+Af8EBTADAQH/MB0GA1UdDgQWBBQIds3LB/8k9sXN7buQvOKEN0Z19zAOBgNVHQ8BAf8EBAMCAQYw
+DQYJKoZIhvcNAQEFBQADggEBAKaorSLOAT2mo/9i0Eidi15ysHhE49wcrwn9I0j6vSrEuVUEtRCj
+jSfeC4Jj0O7eDDd5QVsisrCaQVymcODU0HfLI9MA4GxWL+FpDQ3Zqr8hgVDZBqWo/5U30Kr+4rP1
+mS1FhIrlQgnXdAIv94nYmem8J9RHjboNRhx3zxSkHLmkMcScKHQDNP8zGSal6Q10tz6XxnboJ5aj
+Zt3hrvJBW8qYVoNzcOSGGtIxQbovvi0TWnZvTuhOgQ4/WwMioBK+ZlgRSssDxLQqKi2WF+A5VLxI
+03YnnZotBqbJ7DnSq9ufmgsnAjUpsUCV5/nonFWIGUbWtzT1fs45mtk48VH3Tyw=
+-----END CERTIFICATE-----
+
+TWCA Root Certification Authority
+=================================
+-----BEGIN CERTIFICATE-----
+MIIDezCCAmOgAwIBAgIBATANBgkqhkiG9w0BAQUFADBfMQswCQYDVQQGEwJUVzESMBAGA1UECgwJ
+VEFJV0FOLUNBMRAwDgYDVQQLDAdSb290IENBMSowKAYDVQQDDCFUV0NBIFJvb3QgQ2VydGlmaWNh
+dGlvbiBBdXRob3JpdHkwHhcNMDgwODI4MDcyNDMzWhcNMzAxMjMxMTU1OTU5WjBfMQswCQYDVQQG
+EwJUVzESMBAGA1UECgwJVEFJV0FOLUNBMRAwDgYDVQQLDAdSb290IENBMSowKAYDVQQDDCFUV0NB
+IFJvb3QgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEK
+AoIBAQCwfnK4pAOU5qfeCTiRShFAh6d8WWQUe7UREN3+v9XAu1bihSX0NXIP+FPQQeFEAcK0HMMx
+QhZHhTMidrIKbw/lJVBPhYa+v5guEGcevhEFhgWQxFnQfHgQsIBct+HHK3XLfJ+utdGdIzdjp9xC
+oi2SBBtQwXu4PhvJVgSLL1KbralW6cH/ralYhzC2gfeXRfwZVzsrb+RH9JlF/h3x+JejiB03HFyP
+4HYlmlD4oFT/RJB2I9IyxsOrBr/8+7/zrX2SYgJbKdM1o5OaQ2RgXbL6Mv87BK9NQGr5x+PvI/1r
+y+UPizgN7gr8/g+YnzAx3WxSZfmLgb4i4RxYA7qRG4kHAgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIB
+BjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBRqOFsmjd6LWvJPelSDGRjjCDWmujANBgkqhkiG
+9w0BAQUFAAOCAQEAPNV3PdrfibqHDAhUaiBQkr6wQT25JmSDCi/oQMCXKCeCMErJk/9q56YAf4lC
+mtYR5VPOL8zy2gXE/uJQxDqGfczafhAJO5I1KlOy/usrBdlsXebQ79NqZp4VKIV66IIArB6nCWlW
+QtNoURi+VJq/REG6Sb4gumlc7rh3zc5sH62Dlhh9DrUUOYTxKOkto557HnpyWoOzeW/vtPzQCqVY
+T0bf+215WfKEIlKuD8z7fDvnaspHYcN6+NOSBB+4IIThNlQWx0DeO4pz3N/GCUzf7Nr/1FNCocny
+Yh0igzyXxfkZYiesZSLX0zzG5Y6yU8xJzrww/nsOM5D77dIUkR8Hrw==
+-----END CERTIFICATE-----
+
+Security Communication RootCA2
+==============================
+-----BEGIN CERTIFICATE-----
+MIIDdzCCAl+gAwIBAgIBADANBgkqhkiG9w0BAQsFADBdMQswCQYDVQQGEwJKUDElMCMGA1UEChMc
+U0VDT00gVHJ1c3QgU3lzdGVtcyBDTy4sTFRELjEnMCUGA1UECxMeU2VjdXJpdHkgQ29tbXVuaWNh
+dGlvbiBSb290Q0EyMB4XDTA5MDUyOTA1MDAzOVoXDTI5MDUyOTA1MDAzOVowXTELMAkGA1UEBhMC
+SlAxJTAjBgNVBAoTHFNFQ09NIFRydXN0IFN5c3RlbXMgQ08uLExURC4xJzAlBgNVBAsTHlNlY3Vy
+aXR5IENvbW11bmljYXRpb24gUm9vdENBMjCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEB
+ANAVOVKxUrO6xVmCxF1SrjpDZYBLx/KWvNs2l9amZIyoXvDjChz335c9S672XewhtUGrzbl+dp++
++T42NKA7wfYxEUV0kz1XgMX5iZnK5atq1LXaQZAQwdbWQonCv/Q4EpVMVAX3NuRFg3sUZdbcDE3R
+3n4MqzvEFb46VqZab3ZpUql6ucjrappdUtAtCms1FgkQhNBqyjoGADdH5H5XTz+L62e4iKrFvlNV
+spHEfbmwhRkGeC7bYRr6hfVKkaHnFtWOojnflLhwHyg/i/xAXmODPIMqGplrz95Zajv8bxbXH/1K
+EOtOghY6rCcMU/Gt1SSwawNQwS08Ft1ENCcadfsCAwEAAaNCMEAwHQYDVR0OBBYEFAqFqXdlBZh8
+QIH4D5csOPEK7DzPMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MA0GCSqGSIb3DQEB
+CwUAA4IBAQBMOqNErLlFsceTfsgLCkLfZOoc7llsCLqJX2rKSpWeeo8HxdpFcoJxDjrSzG+ntKEj
+u/Ykn8sX/oymzsLS28yN/HH8AynBbF0zX2S2ZTuJbxh2ePXcokgfGT+Ok+vx+hfuzU7jBBJV1uXk
+3fs+BXziHV7Gp7yXT2g69ekuCkO2r1dcYmh8t/2jioSgrGK+KwmHNPBqAbubKVY8/gA3zyNs8U6q
+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-----
+MIIFuzCCA6OgAwIBAgIIVwoRl0LE48wwDQYJKoZIhvcNAQELBQAwazELMAkGA1UEBhMCSVQxDjAM
+BgNVBAcMBU1pbGFuMSMwIQYDVQQKDBpBY3RhbGlzIFMucC5BLi8wMzM1ODUyMDk2NzEnMCUGA1UE
+AwweQWN0YWxpcyBBdXRoZW50aWNhdGlvbiBSb290IENBMB4XDTExMDkyMjExMjIwMloXDTMwMDky
+MjExMjIwMlowazELMAkGA1UEBhMCSVQxDjAMBgNVBAcMBU1pbGFuMSMwIQYDVQQKDBpBY3RhbGlz
+IFMucC5BLi8wMzM1ODUyMDk2NzEnMCUGA1UEAwweQWN0YWxpcyBBdXRoZW50aWNhdGlvbiBSb290
+IENBMIICIjANBgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAp8bEpSmkLO/lGMWwUKNvUTufClrJ
+wkg4CsIcoBh/kbWHuUA/3R1oHwiD1S0eiKD4j1aPbZkCkpAW1V8IbInX4ay8IMKx4INRimlNAJZa
+by/ARH6jDuSRzVju3PvHHkVH3Se5CAGfpiEd9UEtL0z9KK3giq0itFZljoZUj5NDKd45RnijMCO6
+zfB9E1fAXdKDa0hMxKufgFpbOr3JpyI/gCczWw63igxdBzcIy2zSekciRDXFzMwujt0q7bd9Zg1f
+YVEiVRvjRuPjPdA1YprbrxTIW6HMiRvhMCb8oJsfgadHHwTrozmSBp+Z07/T6k9QnBn+locePGX2
+oxgkg4YQ51Q+qDp2JE+BIcXjDwL4k5RHILv+1A7TaLndxHqEguNTVHnd25zS8gebLra8Pu2Fbe8l
+EfKXGkJh90qX6IuxEAf6ZYGyojnP9zz/GPvG8VqLWeICrHuS0E4UT1lF9gxeKF+w6D9Fz8+vm2/7
+hNN3WpVvrJSEnu68wEqPSpP4RCHiMUVhUE4Q2OM1fEwZtN4Fv6MGn8i1zeQf1xcGDXqVdFUNaBr8
+EBtiZJ1t4JWgw5QHVw0U5r0F+7if5t+L4sbnfpb2U8WANFAoWPASUHEXMLrmeGO89LKtmyuy/uE5
+jF66CyCU3nuDuP/jVo23Eek7jPKxwV2dpAtMK9myGPW1n0sCAwEAAaNjMGEwHQYDVR0OBBYEFFLY
+iDrIn3hm7YnzezhwlMkCAjbQMA8GA1UdEwEB/wQFMAMBAf8wHwYDVR0jBBgwFoAUUtiIOsifeGbt
+ifN7OHCUyQICNtAwDgYDVR0PAQH/BAQDAgEGMA0GCSqGSIb3DQEBCwUAA4ICAQALe3KHwGCmSUyI
+WOYdiPcUZEim2FgKDk8TNd81HdTtBjHIgT5q1d07GjLukD0R0i70jsNjLiNmsGe+b7bAEzlgqqI0
+JZN1Ut6nna0Oh4lScWoWPBkdg/iaKWW+9D+a2fDzWochcYBNy+A4mz+7+uAwTc+G02UQGRjRlwKx
+K3JCaKygvU5a2hi/a5iB0P2avl4VSM0RFbnAKVy06Ij3Pjaut2L9HmLecHgQHEhb2rykOLpn7VU+
+Xlff1ANATIGk0k9jpwlCCRT8AKnCgHNPLsBA2RF7SOp6AsDT6ygBJlh0wcBzIm2Tlf05fbsq4/aC
+4yyXX04fkZT6/iyj2HYauE2yOE+b+h1IYHkm4vP9qdCa6HCPSXrW5b0KDtst842/6+OkfcvHlXHo
+2qN8xcL4dJIEG4aspCJTQLas/kx2z/uUMsA1n3Y/buWQbqCmJqK4LL7RK4X9p2jIugErsWx0Hbhz
+lefut8cl8ABMALJ+tguLHPPAUJ4lueAI3jZm/zel0btUZCzJJ7VLkn5l/9Mt4blOvH+kQSGQQXem
+OR/qnuOf0GZvBeyqdn6/axag67XH/JJULysRJyU3eExRarDzzFhdFPFqSBX/wge2sY0PjlxQRrM9
+vwGYT7JZVEc+NHt4bVaTLnPqZih4zR0Uv6CPLy64Lo7yFIrM6bV8+2ydDKXhlg==
+-----END CERTIFICATE-----
+
+Trustis FPS Root CA
+===================
+-----BEGIN CERTIFICATE-----
+MIIDZzCCAk+gAwIBAgIQGx+ttiD5JNM2a/fH8YygWTANBgkqhkiG9w0BAQUFADBFMQswCQYDVQQG
+EwJHQjEYMBYGA1UEChMPVHJ1c3RpcyBMaW1pdGVkMRwwGgYDVQQLExNUcnVzdGlzIEZQUyBSb290
+IENBMB4XDTAzMTIyMzEyMTQwNloXDTI0MDEyMTExMzY1NFowRTELMAkGA1UEBhMCR0IxGDAWBgNV
+BAoTD1RydXN0aXMgTGltaXRlZDEcMBoGA1UECxMTVHJ1c3RpcyBGUFMgUm9vdCBDQTCCASIwDQYJ
+KoZIhvcNAQEBBQADggEPADCCAQoCggEBAMVQe547NdDfxIzNjpvto8A2mfRC6qc+gIMPpqdZh8mQ
+RUN+AOqGeSoDvT03mYlmt+WKVoaTnGhLaASMk5MCPjDSNzoiYYkchU59j9WvezX2fihHiTHcDnlk
+H5nSW7r+f2C/revnPDgpai/lkQtV/+xvWNUtyd5MZnGPDNcE2gfmHhjjvSkCqPoc4Vu5g6hBSLwa
+cY3nYuUtsuvffM/bq1rKMfFMIvMFE/eC+XN5DL7XSxzA0RU8k0Fk0ea+IxciAIleH2ulrG6nS4zt
+o3Lmr2NNL4XSFDWaLk6M6jKYKIahkQlBOrTh4/L68MkKokHdqeMDx4gVOxzUGpTXn2RZEm0CAwEA
+AaNTMFEwDwYDVR0TAQH/BAUwAwEB/zAfBgNVHSMEGDAWgBS6+nEleYtXQSUhhgtx67JkDoshZzAd
+BgNVHQ4EFgQUuvpxJXmLV0ElIYYLceuyZA6LIWcwDQYJKoZIhvcNAQEFBQADggEBAH5Y//01GX2c
+GE+esCu8jowU/yyg2kdbw++BLa8F6nRIW/M+TgfHbcWzk88iNVy2P3UnXwmWzaD+vkAMXBJV+JOC
+yinpXj9WV4s4NvdFGkwozZ5BuO1WTISkQMi4sKUraXAEasP41BIy+Q7DsdwyhEQsb8tGD+pmQQ9P
+8Vilpg0ND2HepZ5dfWWhPBfnqFVO76DH7cZEf1T1o+CP8HxVIo8ptoGj4W1OLBuAZ+ytIJ8MYmHV
+l/9D7S3B2l0pKoU/rGXuhg8FjZBf3+6f9L/uHfuY5H+QK4R4EA5sSVPvFVtlRkpdr7r7OnIdzfYl
+iB6XzCGcKQENZetX2fNXlrtIzYE=
+-----END CERTIFICATE-----
+
+Buypass Class 2 Root CA
+=======================
+-----BEGIN CERTIFICATE-----
+MIIFWTCCA0GgAwIBAgIBAjANBgkqhkiG9w0BAQsFADBOMQswCQYDVQQGEwJOTzEdMBsGA1UECgwU
+QnV5cGFzcyBBUy05ODMxNjMzMjcxIDAeBgNVBAMMF0J1eXBhc3MgQ2xhc3MgMiBSb290IENBMB4X
+DTEwMTAyNjA4MzgwM1oXDTQwMTAyNjA4MzgwM1owTjELMAkGA1UEBhMCTk8xHTAbBgNVBAoMFEJ1
+eXBhc3MgQVMtOTgzMTYzMzI3MSAwHgYDVQQDDBdCdXlwYXNzIENsYXNzIDIgUm9vdCBDQTCCAiIw
+DQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBANfHXvfBB9R3+0Mh9PT1aeTuMgHbo4Yf5FkNuud1
+g1Lr6hxhFUi7HQfKjK6w3Jad6sNgkoaCKHOcVgb/S2TwDCo3SbXlzwx87vFKu3MwZfPVL4O2fuPn
+9Z6rYPnT8Z2SdIrkHJasW4DptfQxh6NR/Md+oW+OU3fUl8FVM5I+GC911K2GScuVr1QGbNgGE41b
+/+EmGVnAJLqBcXmQRFBoJJRfuLMR8SlBYaNByyM21cHxMlAQTn/0hpPshNOOvEu/XAFOBz3cFIqU
+CqTqc/sLUegTBxj6DvEr0VQVfTzh97QZQmdiXnfgolXsttlpF9U6r0TtSsWe5HonfOV116rLJeff
+awrbD02TTqigzXsu8lkBarcNuAeBfos4GzjmCleZPe4h6KP1DBbdi+w0jpwqHAAVF41og9JwnxgI
+zRFo1clrUs3ERo/ctfPYV3Me6ZQ5BL/T3jjetFPsaRyifsSP5BtwrfKi+fv3FmRmaZ9JUaLiFRhn
+Bkp/1Wy1TbMz4GHrXb7pmA8y1x1LPC5aAVKRCfLf6o3YBkBjqhHk/sM3nhRSP/TizPJhk9H9Z2vX
+Uq6/aKtAQ6BXNVN48FP4YUIHZMbXb5tMOA1jrGKvNouicwoN9SG9dKpN6nIDSdvHXx1iY8f93ZHs
+M+71bbRuMGjeyNYmsHVee7QHIJihdjK4TWxPAgMBAAGjQjBAMA8GA1UdEwEB/wQFMAMBAf8wHQYD
+VR0OBBYEFMmAd+BikoL1RpzzuvdMw964o605MA4GA1UdDwEB/wQEAwIBBjANBgkqhkiG9w0BAQsF
+AAOCAgEAU18h9bqwOlI5LJKwbADJ784g7wbylp7ppHR/ehb8t/W2+xUbP6umwHJdELFx7rxP462s
+A20ucS6vxOOto70MEae0/0qyexAQH6dXQbLArvQsWdZHEIjzIVEpMMpghq9Gqx3tOluwlN5E40EI
+osHsHdb9T7bWR9AUC8rmyrV7d35BH16Dx7aMOZawP5aBQW9gkOLo+fsicdl9sz1Gv7SEr5AcD48S
+aq/v7h56rgJKihcrdv6sVIkkLE8/trKnToyokZf7KcZ7XC25y2a2t6hbElGFtQl+Ynhw/qlqYLYd
+DnkM/crqJIByw5c/8nerQyIKx+u2DISCLIBrQYoIwOula9+ZEsuK1V6ADJHgJgg2SMX6OBE1/yWD
+LfJ6v9r9jv6ly0UsH8SIU653DtmadsWOLB2jutXsMq7Aqqz30XpN69QH4kj3Io6wpJ9qzo6ysmD0
+oyLQI+uUWnpp3Q+/QFesa1lQ2aOZ4W7+jQF5JyMV3pKdewlNWudLSDBaGOYKbeaP4NK75t98biGC
+wWg5TbSYWGZizEqQXsP6JwSxeRV0mcy+rSDeJmAc61ZRpqPq5KM/p/9h3PFaTWwyI0PurKju7koS
+CTxdccK+efrCh2gdC/1cacwG0Jp9VJkqyTkaGa9LKkPzY11aWOIv4x3kqdbQCtCev9eBCfHJxyYN
+rJgWVqA=
+-----END CERTIFICATE-----
+
+Buypass Class 3 Root CA
+=======================
+-----BEGIN CERTIFICATE-----
+MIIFWTCCA0GgAwIBAgIBAjANBgkqhkiG9w0BAQsFADBOMQswCQYDVQQGEwJOTzEdMBsGA1UECgwU
+QnV5cGFzcyBBUy05ODMxNjMzMjcxIDAeBgNVBAMMF0J1eXBhc3MgQ2xhc3MgMyBSb290IENBMB4X
+DTEwMTAyNjA4Mjg1OFoXDTQwMTAyNjA4Mjg1OFowTjELMAkGA1UEBhMCTk8xHTAbBgNVBAoMFEJ1
+eXBhc3MgQVMtOTgzMTYzMzI3MSAwHgYDVQQDDBdCdXlwYXNzIENsYXNzIDMgUm9vdCBDQTCCAiIw
+DQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAKXaCpUWUOOV8l6ddjEGMnqb8RB2uACatVI2zSRH
+sJ8YZLya9vrVediQYkwiL944PdbgqOkcLNt4EemOaFEVcsfzM4fkoF0LXOBXByow9c3EN3coTRiR
+5r/VUv1xLXA+58bEiuPwKAv0dpihi4dVsjoT/Lc+JzeOIuOoTyrvYLs9tznDDgFHmV0ST9tD+leh
+7fmdvhFHJlsTmKtdFoqwNxxXnUX/iJY2v7vKB3tvh2PX0DJq1l1sDPGzbjniazEuOQAnFN44wOwZ
+ZoYS6J1yFhNkUsepNxz9gjDthBgd9K5c/3ATAOux9TN6S9ZV+AWNS2mw9bMoNlwUxFFzTWsL8TQH
+2xc519woe2v1n/MuwU8XKhDzzMro6/1rqy6any2CbgTUUgGTLT2G/H783+9CHaZr77kgxve9oKeV
+/afmiSTYzIw0bOIjL9kSGiG5VZFvC5F5GQytQIgLcOJ60g7YaEi7ghM5EFjp2CoHxhLbWNvSO1UQ
+RwUVZ2J+GGOmRj8JDlQyXr8NYnon74Do29lLBlo3WiXQCBJ31G8JUJc9yB3D34xFMFbG02SrZvPA
+Xpacw8Tvw3xrizp5f7NJzz3iiZ+gMEuFuZyUJHmPfWupRWgPK9Dx2hzLabjKSWJtyNBjYt1gD1iq
+j6G8BaVmos8bdrKEZLFMOVLAMLrwjEsCsLa3AgMBAAGjQjBAMA8GA1UdEwEB/wQFMAMBAf8wHQYD
+VR0OBBYEFEe4zf/lb+74suwvTg75JbCOPGvDMA4GA1UdDwEB/wQEAwIBBjANBgkqhkiG9w0BAQsF
+AAOCAgEAACAjQTUEkMJAYmDv4jVM1z+s4jSQuKFvdvoWFqRINyzpkMLyPPgKn9iB5btb2iUspKdV
+cSQy9sgL8rxq+JOssgfCX5/bzMiKqr5qb+FJEMwx14C7u8jYog5kV+qi9cKpMRXSIGrs/CIBKM+G
+uIAeqcwRpTzyFrNHnfzSgCHEy9BHcEGhyoMZCCxt8l13nIoUE9Q2HJLw5QY33KbmkJs4j1xrG0aG
+Q0JfPgEHU1RdZX33inOhmlRaHylDFCfChQ+1iHsaO5S3HWCntZznKWlXWpuTekMwGwPXYshApqr8
+ZORK15FTAaggiG6cX0S5y2CBNOxv033aSF/rtJC8LakcC6wc1aJoIIAE1vyxjy+7SjENSoYc6+I2
+KSb12tjE8nVhz36udmNKekBlk4f4HoCMhuWG1o8O/FMsYOgWYRqiPkN7zTlgVGr18okmAWiDSKIz
+6MkEkbIRNBE+6tBDGR8Dk5AM/1E9V/RBbuHLoL7ryWPNbczk+DaqaJ3tvV2XcEQNtg413OEMXbug
+UZTLfhbrES+jkkXITHHZvMmZUldGL1DPvTVp9D0VzgalLA8+9oG6lLvDu79leNKGef9JOxqDDPDe
+eOzI8k1MGt6CKfjBWtrt7uYnXuhF0J0cUahoq0Tj0Itq4/g7u9xN12TyUb7mqqta6THuBrxzvxNi
+Cp/HuZc=
+-----END CERTIFICATE-----
+
+T-TeleSec GlobalRoot Class 3
+============================
+-----BEGIN CERTIFICATE-----
+MIIDwzCCAqugAwIBAgIBATANBgkqhkiG9w0BAQsFADCBgjELMAkGA1UEBhMCREUxKzApBgNVBAoM
+IlQtU3lzdGVtcyBFbnRlcnByaXNlIFNlcnZpY2VzIEdtYkgxHzAdBgNVBAsMFlQtU3lzdGVtcyBU
+cnVzdCBDZW50ZXIxJTAjBgNVBAMMHFQtVGVsZVNlYyBHbG9iYWxSb290IENsYXNzIDMwHhcNMDgx
+MDAxMTAyOTU2WhcNMzMxMDAxMjM1OTU5WjCBgjELMAkGA1UEBhMCREUxKzApBgNVBAoMIlQtU3lz
+dGVtcyBFbnRlcnByaXNlIFNlcnZpY2VzIEdtYkgxHzAdBgNVBAsMFlQtU3lzdGVtcyBUcnVzdCBD
+ZW50ZXIxJTAjBgNVBAMMHFQtVGVsZVNlYyBHbG9iYWxSb290IENsYXNzIDMwggEiMA0GCSqGSIb3
+DQEBAQUAA4IBDwAwggEKAoIBAQC9dZPwYiJvJK7genasfb3ZJNW4t/zN8ELg63iIVl6bmlQdTQyK
+9tPPcPRStdiTBONGhnFBSivwKixVA9ZIw+A5OO3yXDw/RLyTPWGrTs0NvvAgJ1gORH8EGoel15YU
+NpDQSXuhdfsaa3Ox+M6pCSzyU9XDFES4hqX2iys52qMzVNn6chr3IhUciJFrf2blw2qAsCTz34ZF
+iP0Zf3WHHx+xGwpzJFu5ZeAsVMhg02YXP+HMVDNzkQI6pn97djmiH5a2OK61yJN0HZ65tOVgnS9W
+0eDrXltMEnAMbEQgqxHY9Bn20pxSN+f6tsIxO0rUFJmtxxr1XV/6B7h8DR/Wgx6zAgMBAAGjQjBA
+MA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMB0GA1UdDgQWBBS1A/d2O2GCahKqGFPr
+AyGUv/7OyjANBgkqhkiG9w0BAQsFAAOCAQEAVj3vlNW92nOyWL6ukK2YJ5f+AbGwUgC4TeQbIXQb
+fsDuXmkqJa9c1h3a0nnJ85cp4IaH3gRZD/FZ1GSFS5mvJQQeyUapl96Cshtwn5z2r3Ex3XsFpSzT
+ucpH9sry9uetuUg/vBa3wW306gmv7PO15wWeph6KU1HWk4HMdJP2udqmJQV0eVp+QD6CSyYRMG7h
+P0HHRwA11fXT91Q+gT3aSWqas+8QPebrb9HIIkfLzM8BMZLZGOMivgkeGj5asuRrDFR6fUNOuIml
+e9eiPZaGzPImNC1qkp2aGtAw4l1OBLBfiyB+d8E9lYLRRpo7PHi4b6HQDWSieB4pTpPDpFQUWw==
+-----END CERTIFICATE-----
+
+EE Certification Centre Root CA
+===============================
+-----BEGIN CERTIFICATE-----
+MIIEAzCCAuugAwIBAgIQVID5oHPtPwBMyonY43HmSjANBgkqhkiG9w0BAQUFADB1MQswCQYDVQQG
+EwJFRTEiMCAGA1UECgwZQVMgU2VydGlmaXRzZWVyaW1pc2tlc2t1czEoMCYGA1UEAwwfRUUgQ2Vy
+dGlmaWNhdGlvbiBDZW50cmUgUm9vdCBDQTEYMBYGCSqGSIb3DQEJARYJcGtpQHNrLmVlMCIYDzIw
+MTAxMDMwMTAxMDMwWhgPMjAzMDEyMTcyMzU5NTlaMHUxCzAJBgNVBAYTAkVFMSIwIAYDVQQKDBlB
+UyBTZXJ0aWZpdHNlZXJpbWlza2Vza3VzMSgwJgYDVQQDDB9FRSBDZXJ0aWZpY2F0aW9uIENlbnRy
+ZSBSb290IENBMRgwFgYJKoZIhvcNAQkBFglwa2lAc2suZWUwggEiMA0GCSqGSIb3DQEBAQUAA4IB
+DwAwggEKAoIBAQDIIMDs4MVLqwd4lfNE7vsLDP90jmG7sWLqI9iroWUyeuuOF0+W2Ap7kaJjbMeM
+TC55v6kF/GlclY1i+blw7cNRfdCT5mzrMEvhvH2/UpvObntl8jixwKIy72KyaOBhU8E2lf/slLo2
+rpwcpzIP5Xy0xm90/XsY6KxX7QYgSzIwWFv9zajmofxwvI6Sc9uXp3whrj3B9UiHbCe9nyV0gVWw
+93X2PaRka9ZP585ArQ/dMtO8ihJTmMmJ+xAdTX7Nfh9WDSFwhfYggx/2uh8Ej+p3iDXE/+pOoYtN
+P2MbRMNE1CV2yreN1x5KZmTNXMWcg+HCCIia7E6j8T4cLNlsHaFLAgMBAAGjgYowgYcwDwYDVR0T
+AQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0OBBYEFBLyWj7qVhy/zQas8fElyalL1BSZ
+MEUGA1UdJQQ+MDwGCCsGAQUFBwMCBggrBgEFBQcDAQYIKwYBBQUHAwMGCCsGAQUFBwMEBggrBgEF
+BQcDCAYIKwYBBQUHAwkwDQYJKoZIhvcNAQEFBQADggEBAHv25MANqhlHt01Xo/6tu7Fq1Q+e2+Rj
+xY6hUFaTlrg4wCQiZrxTFGGVv9DHKpY5P30osxBAIWrEr7BSdxjhlthWXePdNl4dp1BUoMUq5KqM
+lIpPnTX/dqQGE5Gion0ARD9V04I8GtVbvFZMIi5GQ4okQC3zErg7cBqklrkar4dBGmoYDQZPxz5u
+uSlNDUmJEYcyW+ZLBMjkXOZ0c5RdFpgTlf7727FE5TpwrDdr5rMzcijJs1eg9gIWiAYLtqZLICjU
+3j2LrTcFU3T+bsy8QxdxXvnFzBqpYe73dgzzcvRyrc9yAjYHR8/vGVCJYMzpJJUPwssd8m92kMfM
+dcGWxZ0=
+-----END CERTIFICATE-----
+
+D-TRUST Root Class 3 CA 2 2009
+==============================
+-----BEGIN CERTIFICATE-----
+MIIEMzCCAxugAwIBAgIDCYPzMA0GCSqGSIb3DQEBCwUAME0xCzAJBgNVBAYTAkRFMRUwEwYDVQQK
+DAxELVRydXN0IEdtYkgxJzAlBgNVBAMMHkQtVFJVU1QgUm9vdCBDbGFzcyAzIENBIDIgMjAwOTAe
+Fw0wOTExMDUwODM1NThaFw0yOTExMDUwODM1NThaME0xCzAJBgNVBAYTAkRFMRUwEwYDVQQKDAxE
+LVRydXN0IEdtYkgxJzAlBgNVBAMMHkQtVFJVU1QgUm9vdCBDbGFzcyAzIENBIDIgMjAwOTCCASIw
+DQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBANOySs96R+91myP6Oi/WUEWJNTrGa9v+2wBoqOAD
+ER03UAifTUpolDWzU9GUY6cgVq/eUXjsKj3zSEhQPgrfRlWLJ23DEE0NkVJD2IfgXU42tSHKXzlA
+BF9bfsyjxiupQB7ZNoTWSPOSHjRGICTBpFGOShrvUD9pXRl/RcPHAY9RySPocq60vFYJfxLLHLGv
+KZAKyVXMD9O0Gu1HNVpK7ZxzBCHQqr0ME7UAyiZsxGsMlFqVlNpQmvH/pStmMaTJOKDfHR+4CS7z
+p+hnUquVH+BGPtikw8paxTGA6Eian5Rp/hnd2HN8gcqW3o7tszIFZYQ05ub9VxC1X3a/L7AQDcUC
+AwEAAaOCARowggEWMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFP3aFMSfMN4hvR5COfyrYyNJ
+4PGEMA4GA1UdDwEB/wQEAwIBBjCB0wYDVR0fBIHLMIHIMIGAoH6gfIZ6bGRhcDovL2RpcmVjdG9y
+eS5kLXRydXN0Lm5ldC9DTj1ELVRSVVNUJTIwUm9vdCUyMENsYXNzJTIwMyUyMENBJTIwMiUyMDIw
+MDksTz1ELVRydXN0JTIwR21iSCxDPURFP2NlcnRpZmljYXRlcmV2b2NhdGlvbmxpc3QwQ6BBoD+G
+PWh0dHA6Ly93d3cuZC10cnVzdC5uZXQvY3JsL2QtdHJ1c3Rfcm9vdF9jbGFzc18zX2NhXzJfMjAw
+OS5jcmwwDQYJKoZIhvcNAQELBQADggEBAH+X2zDI36ScfSF6gHDOFBJpiBSVYEQBrLLpME+bUMJm
+2H6NMLVwMeniacfzcNsgFYbQDfC+rAF1hM5+n02/t2A7nPPKHeJeaNijnZflQGDSNiH+0LS4F9p0
+o3/U37CYAqxva2ssJSRyoWXuJVrl5jLn8t+rSfrzkGkj2wTZ51xY/GXUl77M/C4KzCUqNQT4YJEV
+dT1B/yMfGchs64JTBKbkTCJNjYy6zltz7GRUUG3RnFX7acM2w4y8PIWmawomDeCTmGCufsYkl4ph
+X5GOZpIJhzbNi5stPvZR1FDUWSi9g/LMKHtThm3YJohw1+qRzT65ysCQblrGXnRl11z+o+I=
+-----END CERTIFICATE-----
+
+D-TRUST Root Class 3 CA 2 EV 2009
+=================================
+-----BEGIN CERTIFICATE-----
+MIIEQzCCAyugAwIBAgIDCYP0MA0GCSqGSIb3DQEBCwUAMFAxCzAJBgNVBAYTAkRFMRUwEwYDVQQK
+DAxELVRydXN0IEdtYkgxKjAoBgNVBAMMIUQtVFJVU1QgUm9vdCBDbGFzcyAzIENBIDIgRVYgMjAw
+OTAeFw0wOTExMDUwODUwNDZaFw0yOTExMDUwODUwNDZaMFAxCzAJBgNVBAYTAkRFMRUwEwYDVQQK
+DAxELVRydXN0IEdtYkgxKjAoBgNVBAMMIUQtVFJVU1QgUm9vdCBDbGFzcyAzIENBIDIgRVYgMjAw
+OTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoCggEBAJnxhDRwui+3MKCOvXwEz75ivJn9gpfS
+egpnljgJ9hBOlSJzmY3aFS3nBfwZcyK3jpgAvDw9rKFs+9Z5JUut8Mxk2og+KbgPCdM03TP1YtHh
+zRnp7hhPTFiu4h7WDFsVWtg6uMQYZB7jM7K1iXdODL/ZlGsTl28So/6ZqQTMFexgaDbtCHu39b+T
+7WYxg4zGcTSHThfqr4uRjRxWQa4iN1438h3Z0S0NL2lRp75mpoo6Kr3HGrHhFPC+Oh25z1uxav60
+sUYgovseO3Dvk5h9jHOW8sXvhXCtKSb8HgQ+HKDYD8tSg2J87otTlZCpV6LqYQXY+U3EJ/pure35
+11H3a6UCAwEAAaOCASQwggEgMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFNOUikxiEyoZLsyv
+cop9NteaHNxnMA4GA1UdDwEB/wQEAwIBBjCB3QYDVR0fBIHVMIHSMIGHoIGEoIGBhn9sZGFwOi8v
+ZGlyZWN0b3J5LmQtdHJ1c3QubmV0L0NOPUQtVFJVU1QlMjBSb290JTIwQ2xhc3MlMjAzJTIwQ0El
+MjAyJTIwRVYlMjAyMDA5LE89RC1UcnVzdCUyMEdtYkgsQz1ERT9jZXJ0aWZpY2F0ZXJldm9jYXRp
+b25saXN0MEagRKBChkBodHRwOi8vd3d3LmQtdHJ1c3QubmV0L2NybC9kLXRydXN0X3Jvb3RfY2xh
+c3NfM19jYV8yX2V2XzIwMDkuY3JsMA0GCSqGSIb3DQEBCwUAA4IBAQA07XtaPKSUiO8aEXUHL7P+
+PPoeUSbrh/Yp3uDx1MYkCenBz1UbtDDZzhr+BlGmFaQt77JLvyAoJUnRpjZ3NOhk31KxEcdzes05
+nsKtjHEh8lprr988TlWvsoRlFIm5d8sqMb7Po23Pb0iUMkZv53GMoKaEGTcH8gNFCSuGdXzfX2lX
+ANtu2KZyIktQ1HWYVt+3GP9DQ1CuekR78HlR10M9p9OB0/DJT7naxpeG0ILD5EJt/rDiZE4OJudA
+NCa1CInXCGNjOCd1HjPqbqjdn5lPdE2BiYBL3ZqXKVwvvoFBuYz/6n1gBp7N1z3TLqMVvKjmJuVv
+w9y4AyHqnxbxLFS1
+-----END CERTIFICATE-----
+
+CA Disig Root R1
+================
+-----BEGIN CERTIFICATE-----
+MIIFaTCCA1GgAwIBAgIJAMMDmu5QkG4oMA0GCSqGSIb3DQEBBQUAMFIxCzAJBgNVBAYTAlNLMRMw
+EQYDVQQHEwpCcmF0aXNsYXZhMRMwEQYDVQQKEwpEaXNpZyBhLnMuMRkwFwYDVQQDExBDQSBEaXNp
+ZyBSb290IFIxMB4XDTEyMDcxOTA5MDY1NloXDTQyMDcxOTA5MDY1NlowUjELMAkGA1UEBhMCU0sx
+EzARBgNVBAcTCkJyYXRpc2xhdmExEzARBgNVBAoTCkRpc2lnIGEucy4xGTAXBgNVBAMTEENBIERp
+c2lnIFJvb3QgUjEwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCqw3j33Jijp1pedxiy
+3QRkD2P9m5YJgNXoqqXinCaUOuiZc4yd39ffg/N4T0Dhf9Kn0uXKE5Pn7cZ3Xza1lK/oOI7bm+V8
+u8yN63Vz4STN5qctGS7Y1oprFOsIYgrY3LMATcMjfF9DCCMyEtztDK3AfQ+lekLZWnDZv6fXARz2
+m6uOt0qGeKAeVjGu74IKgEH3G8muqzIm1Cxr7X1r5OJeIgpFy4QxTaz+29FHuvlglzmxZcfe+5nk
+CiKxLU3lSCZpq+Kq8/v8kiky6bM+TR8noc2OuRf7JT7JbvN32g0S9l3HuzYQ1VTW8+DiR0jm3hTa
+YVKvJrT1cU/J19IG32PK/yHoWQbgCNWEFVP3Q+V8xaCJmGtzxmjOZd69fwX3se72V6FglcXM6pM6
+vpmumwKjrckWtc7dXpl4fho5frLABaTAgqWjR56M6ly2vGfb5ipN0gTco65F97yLnByn1tUD3AjL
+LhbKXEAz6GfDLuemROoRRRw1ZS0eRWEkG4IupZ0zXWX4Qfkuy5Q/H6MMMSRE7cderVC6xkGbrPAX
+ZcD4XW9boAo0PO7X6oifmPmvTiT6l7Jkdtqr9O3jw2Dv1fkCyC2fg69naQanMVXVz0tv/wQFx1is
+XxYb5dKj6zHbHzMVTdDypVP1y+E9Tmgt2BLdqvLmTZtJ5cUoobqwWsagtQIDAQABo0IwQDAPBgNV
+HRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUiQq0OJMa5qvum5EY+fU8PjXQ
+04IwDQYJKoZIhvcNAQEFBQADggIBADKL9p1Kyb4U5YysOMo6CdQbzoaz3evUuii+Eq5FLAR0rBNR
+xVgYZk2C2tXck8An4b58n1KeElb21Zyp9HWc+jcSjxyT7Ff+Bw+r1RL3D65hXlaASfX8MPWbTx9B
+LxyE04nH4toCdu0Jz2zBuByDHBb6lM19oMgY0sidbvW9adRtPTXoHqJPYNcHKfyyo6SdbhWSVhlM
+CrDpfNIZTUJG7L399ldb3Zh+pE3McgODWF3vkzpBemOqfDqo9ayk0d2iLbYq/J8BjuIQscTK5Gfb
+VSUZP/3oNn6z4eGBrxEWi1CXYBmCAMBrTXO40RMHPuq2MU/wQppt4hF05ZSsjYSVPCGvxdpHyN85
+YmLLW1AL14FABZyb7bq2ix4Eb5YgOe2kfSnbSM6C3NQCjR0EMVrHS/BsYVLXtFHCgWzN4funodKS
+ds+xDzdYpPJScWc/DIh4gInByLUfkmO+p3qKViwaqKactV2zY9ATIKHrkWzQjX2v3wvkF7mGnjix
+lAxYjOBVqjtjbZqJYLhkKpLGN/R+Q0O3c+gB53+XD9fyexn9GtePyfqFa3qdnom2piiZk4hA9z7N
+UaPK6u95RyG1/jLix8NRb76AdPCkwzryT+lf3xkK8jsTQ6wxpLPn6/wY1gGp8yqPNg7rtLG8t0zJ
+a7+h89n07eLw4+1knj0vllJPgFOL
+-----END CERTIFICATE-----
+
+CA Disig Root R2
+================
+-----BEGIN CERTIFICATE-----
+MIIFaTCCA1GgAwIBAgIJAJK4iNuwisFjMA0GCSqGSIb3DQEBCwUAMFIxCzAJBgNVBAYTAlNLMRMw
+EQYDVQQHEwpCcmF0aXNsYXZhMRMwEQYDVQQKEwpEaXNpZyBhLnMuMRkwFwYDVQQDExBDQSBEaXNp
+ZyBSb290IFIyMB4XDTEyMDcxOTA5MTUzMFoXDTQyMDcxOTA5MTUzMFowUjELMAkGA1UEBhMCU0sx
+EzARBgNVBAcTCkJyYXRpc2xhdmExEzARBgNVBAoTCkRpc2lnIGEucy4xGTAXBgNVBAMTEENBIERp
+c2lnIFJvb3QgUjIwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCio8QACdaFXS1tFPbC
+w3OeNcJxVX6B+6tGUODBfEl45qt5WDza/3wcn9iXAng+a0EE6UG9vgMsRfYvZNSrXaNHPWSb6Wia
+xswbP7q+sos0Ai6YVRn8jG+qX9pMzk0DIaPY0jSTVpbLTAwAFjxfGs3Ix2ymrdMxp7zo5eFm1tL7
+A7RBZckQrg4FY8aAamkw/dLukO8NJ9+flXP04SXabBbeQTg06ov80egEFGEtQX6sx3dOy1FU+16S
+GBsEWmjGycT6txOgmLcRK7fWV8x8nhfRyyX+hk4kLlYMeE2eARKmK6cBZW58Yh2EhN/qwGu1pSqV
+g8NTEQxzHQuyRpDRQjrOQG6Vrf/GlK1ul4SOfW+eioANSW1z4nuSHsPzwfPrLgVv2RvPN3YEyLRa
+5Beny912H9AZdugsBbPWnDTYltxhh5EF5EQIM8HauQhl1K6yNg3ruji6DOWbnuuNZt2Zz9aJQfYE
+koopKW1rOhzndX0CcQ7zwOe9yxndnWCywmZgtrEE7snmhrmaZkCo5xHtgUUDi/ZnWejBBhG93c+A
+Ak9lQHhcR1DIm+YfgXvkRKhbhZri3lrVx/k6RGZL5DJUfORsnLMOPReisjQS1n6yqEm70XooQL6i
+Fh/f5DcfEXP7kAplQ6INfPgGAVUzfbANuPT1rqVCV3w2EYx7XsQDnYx5nQIDAQABo0IwQDAPBgNV
+HRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUtZn4r7CU9eMg1gqtzk5WpC5u
+Qu0wDQYJKoZIhvcNAQELBQADggIBACYGXnDnZTPIgm7ZnBc6G3pmsgH2eDtpXi/q/075KMOYKmFM
+tCQSin1tERT3nLXK5ryeJ45MGcipvXrA1zYObYVybqjGom32+nNjf7xueQgcnYqfGopTpti72TVV
+sRHFqQOzVju5hJMiXn7B9hJSi+osZ7z+Nkz1uM/Rs0mSO9MpDpkblvdhuDvEK7Z4bLQjb/D907Je
+dR+Zlais9trhxTF7+9FGs9K8Z7RiVLoJ92Owk6Ka+elSLotgEqv89WBW7xBci8QaQtyDW2QOy7W8
+1k/BfDxujRNt+3vrMNDcTa/F1balTFtxyegxvug4BkihGuLq0t4SOVga/4AOgnXmt8kHbA7v/zjx
+mHHEt38OFdAlab0inSvtBfZGR6ztwPDUO+Ls7pZbkBNOHlY667DvlruWIxG68kOGdGSVyCh13x01
+utI3gzhTODY7z2zp+WsO0PsE6E9312UBeIYMej4hYvF/Y3EMyZ9E26gnonW+boE+18DrG5gPcFw0
+sorMwIUY6256s/daoQe/qUKS82Ail+QUoQebTnbAjn39pCXHR+3/H3OszMOl6W8KjptlwlCFtaOg
+UxLMVYdh84GuEEZhvUQhuMI9dM9+JDX6HAcOmz0iyu8xL4ysEr3vQCj8KWefshNPZiTEUxnpHikV
+7+ZtsH8tZ/3zbBt1RqPlShfppNcL
+-----END CERTIFICATE-----
+
+ACCVRAIZ1
+=========
+-----BEGIN CERTIFICATE-----
+MIIH0zCCBbugAwIBAgIIXsO3pkN/pOAwDQYJKoZIhvcNAQEFBQAwQjESMBAGA1UEAwwJQUNDVlJB
+SVoxMRAwDgYDVQQLDAdQS0lBQ0NWMQ0wCwYDVQQKDARBQ0NWMQswCQYDVQQGEwJFUzAeFw0xMTA1
+MDUwOTM3MzdaFw0zMDEyMzEwOTM3MzdaMEIxEjAQBgNVBAMMCUFDQ1ZSQUlaMTEQMA4GA1UECwwH
+UEtJQUNDVjENMAsGA1UECgwEQUNDVjELMAkGA1UEBhMCRVMwggIiMA0GCSqGSIb3DQEBAQUAA4IC
+DwAwggIKAoICAQCbqau/YUqXry+XZpp0X9DZlv3P4uRm7x8fRzPCRKPfmt4ftVTdFXxpNRFvu8gM
+jmoYHtiP2Ra8EEg2XPBjs5BaXCQ316PWywlxufEBcoSwfdtNgM3802/J+Nq2DoLSRYWoG2ioPej0
+RGy9ocLLA76MPhMAhN9KSMDjIgro6TenGEyxCQ0jVn8ETdkXhBilyNpAlHPrzg5XPAOBOp0KoVdD
+aaxXbXmQeOW1tDvYvEyNKKGno6e6Ak4l0Squ7a4DIrhrIA8wKFSVf+DuzgpmndFALW4ir50awQUZ
+0m/A8p/4e7MCQvtQqR0tkw8jq8bBD5L/0KIV9VMJcRz/RROE5iZe+OCIHAr8Fraocwa48GOEAqDG
+WuzndN9wrqODJerWx5eHk6fGioozl2A3ED6XPm4pFdahD9GILBKfb6qkxkLrQaLjlUPTAYVtjrs7
+8yM2x/474KElB0iryYl0/wiPgL/AlmXz7uxLaL2diMMxs0Dx6M/2OLuc5NF/1OVYm3z61PMOm3WR
+5LpSLhl+0fXNWhn8ugb2+1KoS5kE3fj5tItQo05iifCHJPqDQsGH+tUtKSpacXpkatcnYGMN285J
+9Y0fkIkyF/hzQ7jSWpOGYdbhdQrqeWZ2iE9x6wQl1gpaepPluUsXQA+xtrn13k/c4LOsOxFwYIRK
+Q26ZIMApcQrAZQIDAQABo4ICyzCCAscwfQYIKwYBBQUHAQEEcTBvMEwGCCsGAQUFBzAChkBodHRw
+Oi8vd3d3LmFjY3YuZXMvZmlsZWFkbWluL0FyY2hpdm9zL2NlcnRpZmljYWRvcy9yYWl6YWNjdjEu
+Y3J0MB8GCCsGAQUFBzABhhNodHRwOi8vb2NzcC5hY2N2LmVzMB0GA1UdDgQWBBTSh7Tj3zcnk1X2
+VuqB5TbMjB4/vTAPBgNVHRMBAf8EBTADAQH/MB8GA1UdIwQYMBaAFNKHtOPfNyeTVfZW6oHlNsyM
+Hj+9MIIBcwYDVR0gBIIBajCCAWYwggFiBgRVHSAAMIIBWDCCASIGCCsGAQUFBwICMIIBFB6CARAA
+QQB1AHQAbwByAGkAZABhAGQAIABkAGUAIABDAGUAcgB0AGkAZgBpAGMAYQBjAGkA8wBuACAAUgBh
+AO0AegAgAGQAZQAgAGwAYQAgAEEAQwBDAFYAIAAoAEEAZwBlAG4AYwBpAGEAIABkAGUAIABUAGUA
+YwBuAG8AbABvAGcA7QBhACAAeQAgAEMAZQByAHQAaQBmAGkAYwBhAGMAaQDzAG4AIABFAGwAZQBj
+AHQAcgDzAG4AaQBjAGEALAAgAEMASQBGACAAUQA0ADYAMAAxADEANQA2AEUAKQAuACAAQwBQAFMA
+IABlAG4AIABoAHQAdABwADoALwAvAHcAdwB3AC4AYQBjAGMAdgAuAGUAczAwBggrBgEFBQcCARYk
+aHR0cDovL3d3dy5hY2N2LmVzL2xlZ2lzbGFjaW9uX2MuaHRtMFUGA1UdHwROMEwwSqBIoEaGRGh0
+dHA6Ly93d3cuYWNjdi5lcy9maWxlYWRtaW4vQXJjaGl2b3MvY2VydGlmaWNhZG9zL3JhaXphY2N2
+MV9kZXIuY3JsMA4GA1UdDwEB/wQEAwIBBjAXBgNVHREEEDAOgQxhY2N2QGFjY3YuZXMwDQYJKoZI
+hvcNAQEFBQADggIBAJcxAp/n/UNnSEQU5CmH7UwoZtCPNdpNYbdKl02125DgBS4OxnnQ8pdpD70E
+R9m+27Up2pvZrqmZ1dM8MJP1jaGo/AaNRPTKFpV8M9xii6g3+CfYCS0b78gUJyCpZET/LtZ1qmxN
+YEAZSUNUY9rizLpm5U9EelvZaoErQNV/+QEnWCzI7UiRfD+mAM/EKXMRNt6GGT6d7hmKG9Ww7Y49
+nCrADdg9ZuM8Db3VlFzi4qc1GwQA9j9ajepDvV+JHanBsMyZ4k0ACtrJJ1vnE5Bc5PUzolVt3OAJ
+TS+xJlsndQAJxGJ3KQhfnlmstn6tn1QwIgPBHnFk/vk4CpYY3QIUrCPLBhwepH2NDd4nQeit2hW3
+sCPdK6jT2iWH7ehVRE2I9DZ+hJp4rPcOVkkO1jMl1oRQQmwgEh0q1b688nCBpHBgvgW1m54ERL5h
+I6zppSSMEYCUWqKiuUnSwdzRp+0xESyeGabu4VXhwOrPDYTkF7eifKXeVSUG7szAh1xA2syVP1Xg
+Nce4hL60Xc16gwFy7ofmXx2utYXGJt/mwZrpHgJHnyqobalbz+xFd3+YJ5oyXSrjhO7FmGYvliAd
+3djDJ9ew+f7Zfc3Qn48LFFhRny+Lwzgt3uiP1o2HpPVWQxaZLPSkVrQ0uGE3ycJYgBugl6H8WY3p
+EfbRD0tVNEYqi4Y7
+-----END CERTIFICATE-----
+
+TWCA Global Root CA
+===================
+-----BEGIN CERTIFICATE-----
+MIIFQTCCAymgAwIBAgICDL4wDQYJKoZIhvcNAQELBQAwUTELMAkGA1UEBhMCVFcxEjAQBgNVBAoT
+CVRBSVdBTi1DQTEQMA4GA1UECxMHUm9vdCBDQTEcMBoGA1UEAxMTVFdDQSBHbG9iYWwgUm9vdCBD
+QTAeFw0xMjA2MjcwNjI4MzNaFw0zMDEyMzExNTU5NTlaMFExCzAJBgNVBAYTAlRXMRIwEAYDVQQK
+EwlUQUlXQU4tQ0ExEDAOBgNVBAsTB1Jvb3QgQ0ExHDAaBgNVBAMTE1RXQ0EgR2xvYmFsIFJvb3Qg
+Q0EwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCwBdvI64zEbooh745NnHEKH1Jw7W2C
+nJfF10xORUnLQEK1EjRsGcJ0pDFfhQKX7EMzClPSnIyOt7h52yvVavKOZsTuKwEHktSz0ALfUPZV
+r2YOy+BHYC8rMjk1Ujoog/h7FsYYuGLWRyWRzvAZEk2tY/XTP3VfKfChMBwqoJimFb3u/Rk28OKR
+Q4/6ytYQJ0lM793B8YVwm8rqqFpD/G2Gb3PpN0Wp8DbHzIh1HrtsBv+baz4X7GGqcXzGHaL3SekV
+tTzWoWH1EfcFbx39Eb7QMAfCKbAJTibc46KokWofwpFFiFzlmLhxpRUZyXx1EcxwdE8tmx2RRP1W
+KKD+u4ZqyPpcC1jcxkt2yKsi2XMPpfRaAok/T54igu6idFMqPVMnaR1sjjIsZAAmY2E2TqNGtz99
+sy2sbZCilaLOz9qC5wc0GZbpuCGqKX6mOL6OKUohZnkfs8O1CWfe1tQHRvMq2uYiN2DLgbYPoA/p
+yJV/v1WRBXrPPRXAb94JlAGD1zQbzECl8LibZ9WYkTunhHiVJqRaCPgrdLQABDzfuBSO6N+pjWxn
+kjMdwLfS7JLIvgm/LCkFbwJrnu+8vyq8W8BQj0FwcYeyTbcEqYSjMq+u7msXi7Kx/mzhkIyIqJdI
+zshNy/MGz19qCkKxHh53L46g5pIOBvwFItIm4TFRfTLcDwIDAQABoyMwITAOBgNVHQ8BAf8EBAMC
+AQYwDwYDVR0TAQH/BAUwAwEB/zANBgkqhkiG9w0BAQsFAAOCAgEAXzSBdu+WHdXltdkCY4QWwa6g
+cFGn90xHNcgL1yg9iXHZqjNB6hQbbCEAwGxCGX6faVsgQt+i0trEfJdLjbDorMjupWkEmQqSpqsn
+LhpNgb+E1HAerUf+/UqdM+DyucRFCCEK2mlpc3INvjT+lIutwx4116KD7+U4x6WFH6vPNOw/KP4M
+8VeGTslV9xzU2KV9Bnpv1d8Q34FOIWWxtuEXeZVFBs5fzNxGiWNoRI2T9GRwoD2dKAXDOXC4Ynsg
+/eTb6QihuJ49CcdP+yz4k3ZB3lLg4VfSnQO8d57+nile98FRYB/e2guyLXW3Q0iT5/Z5xoRdgFlg
+lPx4mI88k1HtQJAH32RjJMtOcQWh15QaiDLxInQirqWm2BJpTGCjAu4r7NRjkgtevi92a6O2JryP
+A9gK8kxkRr05YuWW6zRjESjMlfGt7+/cgFhI6Uu46mWs6fyAtbXIRfmswZ/ZuepiiI7E8UuDEq3m
+i4TWnsLrgxifarsbJGAzcMzs9zLzXNl5fe+epP7JI8Mk7hWSsT2RTyaGvWZzJBPqpK5jwa19hAM8
+EHiGG3njxPPyBJUgriOCxLM6AGK/5jYk4Ve6xx6QddVfP5VhK8E7zeWzaGHQRiapIVJpLesux+t3
+zqY6tQMzT3bR51xUAV3LePTJDL/PEo4XLSNolOer/qmyKwbQBM0=
+-----END CERTIFICATE-----
+
+TeliaSonera Root CA v1
+======================
+-----BEGIN CERTIFICATE-----
+MIIFODCCAyCgAwIBAgIRAJW+FqD3LkbxezmCcvqLzZYwDQYJKoZIhvcNAQEFBQAwNzEUMBIGA1UE
+CgwLVGVsaWFTb25lcmExHzAdBgNVBAMMFlRlbGlhU29uZXJhIFJvb3QgQ0EgdjEwHhcNMDcxMDE4
+MTIwMDUwWhcNMzIxMDE4MTIwMDUwWjA3MRQwEgYDVQQKDAtUZWxpYVNvbmVyYTEfMB0GA1UEAwwW
+VGVsaWFTb25lcmEgUm9vdCBDQSB2MTCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAMK+
+6yfwIaPzaSZVfp3FVRaRXP3vIb9TgHot0pGMYzHw7CTww6XScnwQbfQ3t+XmfHnqjLWCi65ItqwA
+3GV17CpNX8GH9SBlK4GoRz6JI5UwFpB/6FcHSOcZrr9FZ7E3GwYq/t75rH2D+1665I+XZ75Ljo1k
+B1c4VWk0Nj0TSO9P4tNmHqTPGrdeNjPUtAa9GAH9d4RQAEX1jF3oI7x+/jXh7VB7qTCNGdMJjmhn
+Xb88lxhTuylixcpecsHHltTbLaC0H2kD7OriUPEMPPCs81Mt8Bz17Ww5OXOAFshSsCPN4D7c3TxH
+oLs1iuKYaIu+5b9y7tL6pe0S7fyYGKkmdtwoSxAgHNN/Fnct7W+A90m7UwW7XWjH1Mh1Fj+JWov3
+F0fUTPHSiXk+TT2YqGHeOh7S+F4D4MHJHIzTjU3TlTazN19jY5szFPAtJmtTfImMMsJu7D0hADnJ
+oWjiUIMusDor8zagrC/kb2HCUQk5PotTubtn2txTuXZZNp1D5SDgPTJghSJRt8czu90VL6R4pgd7
+gUY2BIbdeTXHlSw7sKMXNeVzH7RcWe/a6hBle3rQf5+ztCo3O3CLm1u5K7fsslESl1MpWtTwEhDc
+TwK7EpIvYtQ/aUN8Ddb8WHUBiJ1YFkveupD/RwGJBmr2X7KQarMCpgKIv7NHfirZ1fpoeDVNAgMB
+AAGjPzA9MA8GA1UdEwEB/wQFMAMBAf8wCwYDVR0PBAQDAgEGMB0GA1UdDgQWBBTwj1k4ALP1j5qW
+DNXr+nuqF+gTEjANBgkqhkiG9w0BAQUFAAOCAgEAvuRcYk4k9AwI//DTDGjkk0kiP0Qnb7tt3oNm
+zqjMDfz1mgbldxSR651Be5kqhOX//CHBXfDkH1e3damhXwIm/9fH907eT/j3HEbAek9ALCI18Bmx
+0GtnLLCo4MBANzX2hFxc469CeP6nyQ1Q6g2EdvZR74NTxnr/DlZJLo961gzmJ1TjTQpgcmLNkQfW
+pb/ImWvtxBnmq0wROMVvMeJuScg/doAmAyYp4Db29iBT4xdwNBedY2gea+zDTYa4EzAvXUYNR0PV
+G6pZDrlcjQZIrXSHX8f8MVRBE+LHIQ6e4B4N4cB7Q4WQxYpYxmUKeFfyxiMPAdkgS94P+5KFdSpc
+c41teyWRyu5FrgZLAMzTsVlQ2jqIOylDRl6XK1TOU2+NSueW+r9xDkKLfP0ooNBIytrEgUy7onOT
+JsjrDNYmiLbAJM+7vVvrdX3pCI6GMyx5dwlppYn8s3CQh3aP0yK7Qs69cwsgJirQmz1wHiRszYd2
+qReWt88NkvuOGKmYSdGe/mBEciG5Ge3C9THxOUiIkCR1VBatzvT4aRRkOfujuLpwQMcnHL/EVlP6
+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-----
+MIIDwzCCAqugAwIBAgIBATANBgkqhkiG9w0BAQsFADCBgjELMAkGA1UEBhMCREUxKzApBgNVBAoM
+IlQtU3lzdGVtcyBFbnRlcnByaXNlIFNlcnZpY2VzIEdtYkgxHzAdBgNVBAsMFlQtU3lzdGVtcyBU
+cnVzdCBDZW50ZXIxJTAjBgNVBAMMHFQtVGVsZVNlYyBHbG9iYWxSb290IENsYXNzIDIwHhcNMDgx
+MDAxMTA0MDE0WhcNMzMxMDAxMjM1OTU5WjCBgjELMAkGA1UEBhMCREUxKzApBgNVBAoMIlQtU3lz
+dGVtcyBFbnRlcnByaXNlIFNlcnZpY2VzIEdtYkgxHzAdBgNVBAsMFlQtU3lzdGVtcyBUcnVzdCBD
+ZW50ZXIxJTAjBgNVBAMMHFQtVGVsZVNlYyBHbG9iYWxSb290IENsYXNzIDIwggEiMA0GCSqGSIb3
+DQEBAQUAA4IBDwAwggEKAoIBAQCqX9obX+hzkeXaXPSi5kfl82hVYAUdAqSzm1nzHoqvNK38DcLZ
+SBnuaY/JIPwhqgcZ7bBcrGXHX+0CfHt8LRvWurmAwhiCFoT6ZrAIxlQjgeTNuUk/9k9uN0goOA/F
+vudocP05l03Sx5iRUKrERLMjfTlH6VJi1hKTXrcxlkIF+3anHqP1wvzpesVsqXFP6st4vGCvx970
+2cu+fjOlbpSD8DT6IavqjnKgP6TeMFvvhk1qlVtDRKgQFRzlAVfFmPHmBiiRqiDFt1MmUUOyCxGV
+WOHAD3bZwI18gfNycJ5v/hqO2V81xrJvNHy+SE/iWjnX2J14np+GPgNeGYtEotXHAgMBAAGjQjBA
+MA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMB0GA1UdDgQWBBS/WSA2AHmgoCJrjNXy
+YdK4LMuCSjANBgkqhkiG9w0BAQsFAAOCAQEAMQOiYQsfdOhyNsZt+U2e+iKo4YFWz827n+qrkRk4
+r6p8FU3ztqONpfSO9kSpp+ghla0+AGIWiPACuvxhI+YzmzB6azZie60EI4RYZeLbK4rnJVM3YlNf
+vNoBYimipidx5joifsFvHZVwIEoHNN/q/xWA5brXethbdXwFeilHfkCoMRN3zUA7tFFHei4R40cR
+3p1m0IvVVGb6g1XqfMIpiRvpb7PO4gWEyS8+eIVibslfwXhjdFjASBgMmTnrpMwatXlajRWc2BQN
+9noHV8cigwUtPJslJj0Ys6lDfMjIq2SPDqO/nBudMNva0Bkuqjzx+zOAduTNrRlPBSeOE6Fuwg==
+-----END CERTIFICATE-----
+
+Atos TrustedRoot 2011
+=====================
+-----BEGIN CERTIFICATE-----
+MIIDdzCCAl+gAwIBAgIIXDPLYixfszIwDQYJKoZIhvcNAQELBQAwPDEeMBwGA1UEAwwVQXRvcyBU
+cnVzdGVkUm9vdCAyMDExMQ0wCwYDVQQKDARBdG9zMQswCQYDVQQGEwJERTAeFw0xMTA3MDcxNDU4
+MzBaFw0zMDEyMzEyMzU5NTlaMDwxHjAcBgNVBAMMFUF0b3MgVHJ1c3RlZFJvb3QgMjAxMTENMAsG
+A1UECgwEQXRvczELMAkGA1UEBhMCREUwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQCV
+hTuXbyo7LjvPpvMpNb7PGKw+qtn4TaA+Gke5vJrf8v7MPkfoepbCJI419KkM/IL9bcFyYie96mvr
+54rMVD6QUM+A1JX76LWC1BTFtqlVJVfbsVD2sGBkWXppzwO3bw2+yj5vdHLqqjAqc2K+SZFhyBH+
+DgMq92og3AIVDV4VavzjgsG1xZ1kCWyjWZgHJ8cblithdHFsQ/H3NYkQ4J7sVaE3IqKHBAUsR320
+HLliKWYoyrfhk/WklAOZuXCFteZI6o1Q/NnezG8HDt0Lcp2AMBYHlT8oDv3FdU9T1nSatCQujgKR
+z3bFmx5VdJx4IbHwLfELn8LVlhgf8FQieowHAgMBAAGjfTB7MB0GA1UdDgQWBBSnpQaxLKYJYO7R
+l+lwrrw7GWzbITAPBgNVHRMBAf8EBTADAQH/MB8GA1UdIwQYMBaAFKelBrEspglg7tGX6XCuvDsZ
+bNshMBgGA1UdIAQRMA8wDQYLKwYBBAGwLQMEAQEwDgYDVR0PAQH/BAQDAgGGMA0GCSqGSIb3DQEB
+CwUAA4IBAQAmdzTblEiGKkGdLD4GkGDEjKwLVLgfuXvTBznk+j57sj1O7Z8jvZfza1zv7v1Apt+h
+k6EKhqzvINB5Ab149xnYJDE0BAGmuhWawyfc2E8PzBhj/5kPDpFrdRbhIfzYJsdHt6bPWHJxfrrh
+TZVHO8mvbaG0weyJ9rQPOLXiZNwlz6bb65pcmaHFCN795trV1lpFDMS3wrUU77QR/w4VtfX128a9
+61qn8FYiqTxlVMYVqL2Gns2Dlmh6cYGJ4Qvh6hEbaAjMaZ7snkGeRDImeuKHCnE96+RapNLbxc3G
+3mB/ufNPRJLvKrcYPqcZ2Qt9sTdBQrC6YB3y/gkRsPCHe6ed
+-----END CERTIFICATE-----
+
+QuoVadis Root CA 1 G3
+=====================
+-----BEGIN CERTIFICATE-----
+MIIFYDCCA0igAwIBAgIUeFhfLq0sGUvjNwc1NBMotZbUZZMwDQYJKoZIhvcNAQELBQAwSDELMAkG
+A1UEBhMCQk0xGTAXBgNVBAoTEFF1b1ZhZGlzIExpbWl0ZWQxHjAcBgNVBAMTFVF1b1ZhZGlzIFJv
+b3QgQ0EgMSBHMzAeFw0xMjAxMTIxNzI3NDRaFw00MjAxMTIxNzI3NDRaMEgxCzAJBgNVBAYTAkJN
+MRkwFwYDVQQKExBRdW9WYWRpcyBMaW1pdGVkMR4wHAYDVQQDExVRdW9WYWRpcyBSb290IENBIDEg
+RzMwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCgvlAQjunybEC0BJyFuTHK3C3kEakE
+PBtVwedYMB0ktMPvhd6MLOHBPd+C5k+tR4ds7FtJwUrVu4/sh6x/gpqG7D0DmVIB0jWerNrwU8lm
+PNSsAgHaJNM7qAJGr6Qc4/hzWHa39g6QDbXwz8z6+cZM5cOGMAqNF34168Xfuw6cwI2H44g4hWf6
+Pser4BOcBRiYz5P1sZK0/CPTz9XEJ0ngnjybCKOLXSoh4Pw5qlPafX7PGglTvF0FBM+hSo+LdoIN
+ofjSxxR3W5A2B4GbPgb6Ul5jxaYA/qXpUhtStZI5cgMJYr2wYBZupt0lwgNm3fME0UDiTouG9G/l
+g6AnhF4EwfWQvTA9xO+oabw4m6SkltFi2mnAAZauy8RRNOoMqv8hjlmPSlzkYZqn0ukqeI1RPToV
+7qJZjqlc3sX5kCLliEVx3ZGZbHqfPT2YfF72vhZooF6uCyP8Wg+qInYtyaEQHeTTRCOQiJ/GKubX
+9ZqzWB4vMIkIG1SitZgj7Ah3HJVdYdHLiZxfokqRmu8hqkkWCKi9YSgxyXSthfbZxbGL0eUQMk1f
+iyA6PEkfM4VZDdvLCXVDaXP7a3F98N/ETH3Goy7IlXnLc6KOTk0k+17kBL5yG6YnLUlamXrXXAkg
+t3+UuU/xDRxeiEIbEbfnkduebPRq34wGmAOtzCjvpUfzUwIDAQABo0IwQDAPBgNVHRMBAf8EBTAD
+AQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUo5fW816iEOGrRZ88F2Q87gFwnMwwDQYJKoZI
+hvcNAQELBQADggIBABj6W3X8PnrHX3fHyt/PX8MSxEBd1DKquGrX1RUVRpgjpeaQWxiZTOOtQqOC
+MTaIzen7xASWSIsBx40Bz1szBpZGZnQdT+3Btrm0DWHMY37XLneMlhwqI2hrhVd2cDMT/uFPpiN3
+GPoajOi9ZcnPP/TJF9zrx7zABC4tRi9pZsMbj/7sPtPKlL92CiUNqXsCHKnQO18LwIE6PWThv6ct
+Tr1NxNgpxiIY0MWscgKCP6o6ojoilzHdCGPDdRS5YCgtW2jgFqlmgiNR9etT2DGbe+m3nUvriBbP
++V04ikkwj+3x6xn0dxoxGE1nVGwvb2X52z3sIexe9PSLymBlVNFxZPT5pqOBMzYzcfCkeF9OrYMh
+3jRJjehZrJ3ydlo28hP0r+AJx2EqbPfgna67hkooby7utHnNkDPDs3b69fBsnQGQ+p6Q9pxyz0fa
+wx/kNSBT8lTR32GDpgLiJTjehTItXnOQUl1CxM49S+H5GYQd1aJQzEH7QRTDvdbJWqNjZgKAvQU6
+O0ec7AAmTPWIUb+oI38YB7AL7YsmoWTTYUrrXJ/es69nA7Mf3W1daWhpq1467HxpvMc7hU6eFbm0
+FU/DlXpY18ls6Wy58yljXrQs8C097Vpl4KlbQMJImYFtnh8GKjwStIsPm6Ik8KaN1nrgS7ZklmOV
+hMJKzRwuJIczYOXD
+-----END CERTIFICATE-----
+
+QuoVadis Root CA 2 G3
+=====================
+-----BEGIN CERTIFICATE-----
+MIIFYDCCA0igAwIBAgIURFc0JFuBiZs18s64KztbpybwdSgwDQYJKoZIhvcNAQELBQAwSDELMAkG
+A1UEBhMCQk0xGTAXBgNVBAoTEFF1b1ZhZGlzIExpbWl0ZWQxHjAcBgNVBAMTFVF1b1ZhZGlzIFJv
+b3QgQ0EgMiBHMzAeFw0xMjAxMTIxODU5MzJaFw00MjAxMTIxODU5MzJaMEgxCzAJBgNVBAYTAkJN
+MRkwFwYDVQQKExBRdW9WYWRpcyBMaW1pdGVkMR4wHAYDVQQDExVRdW9WYWRpcyBSb290IENBIDIg
+RzMwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQChriWyARjcV4g/Ruv5r+LrI3HimtFh
+ZiFfqq8nUeVuGxbULX1QsFN3vXg6YOJkApt8hpvWGo6t/x8Vf9WVHhLL5hSEBMHfNrMWn4rjyduY
+NM7YMxcoRvynyfDStNVNCXJJ+fKH46nafaF9a7I6JaltUkSs+L5u+9ymc5GQYaYDFCDy54ejiK2t
+oIz/pgslUiXnFgHVy7g1gQyjO/Dh4fxaXc6AcW34Sas+O7q414AB+6XrW7PFXmAqMaCvN+ggOp+o
+MiwMzAkd056OXbxMmO7FGmh77FOm6RQ1o9/NgJ8MSPsc9PG/Srj61YxxSscfrf5BmrODXfKEVu+l
+V0POKa2Mq1W/xPtbAd0jIaFYAI7D0GoT7RPjEiuA3GfmlbLNHiJuKvhB1PLKFAeNilUSxmn1uIZo
+L1NesNKqIcGY5jDjZ1XHm26sGahVpkUG0CM62+tlXSoREfA7T8pt9DTEceT/AFr2XK4jYIVz8eQQ
+sSWu1ZK7E8EM4DnatDlXtas1qnIhO4M15zHfeiFuuDIIfR0ykRVKYnLP43ehvNURG3YBZwjgQQvD
+6xVu+KQZ2aKrr+InUlYrAoosFCT5v0ICvybIxo/gbjh9Uy3l7ZizlWNof/k19N+IxWA1ksB8aRxh
+lRbQ694Lrz4EEEVlWFA4r0jyWbYW8jwNkALGcC4BrTwV1wIDAQABo0IwQDAPBgNVHRMBAf8EBTAD
+AQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQU7edvdlq/YOxJW8ald7tyFnGbxD0wDQYJKoZI
+hvcNAQELBQADggIBAJHfgD9DCX5xwvfrs4iP4VGyvD11+ShdyLyZm3tdquXK4Qr36LLTn91nMX66
+AarHakE7kNQIXLJgapDwyM4DYvmL7ftuKtwGTTwpD4kWilhMSA/ohGHqPHKmd+RCroijQ1h5fq7K
+pVMNqT1wvSAZYaRsOPxDMuHBR//47PERIjKWnML2W2mWeyAMQ0GaW/ZZGYjeVYg3UQt4XAoeo0L9
+x52ID8DyeAIkVJOviYeIyUqAHerQbj5hLja7NQ4nlv1mNDthcnPxFlxHBlRJAHpYErAK74X9sbgz
+dWqTHBLmYF5vHX/JHyPLhGGfHoJE+V+tYlUkmlKY7VHnoX6XOuYvHxHaU4AshZ6rNRDbIl9qxV6X
+U/IyAgkwo1jwDQHVcsaxfGl7w/U2Rcxhbl5MlMVerugOXou/983g7aEOGzPuVBj+D77vfoRrQ+Nw
+mNtddbINWQeFFSM51vHfqSYP1kjHs6Yi9TM3WpVHn3u6GBVv/9YUZINJ0gpnIdsPNWNgKCLjsZWD
+zYWm3S8P52dSbrsvhXz1SnPnxT7AvSESBT/8twNJAlvIJebiVDj1eYeMHVOyToV7BjjHLPj4sHKN
+JeV3UvQDHEimUF+IIDBu8oJDqz2XhOdT+yHBTw8imoa4WSr2Rz0ZiC3oheGe7IUIarFsNMkd7Egr
+O3jtZsSOeWmD3n+M
+-----END CERTIFICATE-----
+
+QuoVadis Root CA 3 G3
+=====================
+-----BEGIN CERTIFICATE-----
+MIIFYDCCA0igAwIBAgIULvWbAiin23r/1aOp7r0DoM8Sah0wDQYJKoZIhvcNAQELBQAwSDELMAkG
+A1UEBhMCQk0xGTAXBgNVBAoTEFF1b1ZhZGlzIExpbWl0ZWQxHjAcBgNVBAMTFVF1b1ZhZGlzIFJv
+b3QgQ0EgMyBHMzAeFw0xMjAxMTIyMDI2MzJaFw00MjAxMTIyMDI2MzJaMEgxCzAJBgNVBAYTAkJN
+MRkwFwYDVQQKExBRdW9WYWRpcyBMaW1pdGVkMR4wHAYDVQQDExVRdW9WYWRpcyBSb290IENBIDMg
+RzMwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCzyw4QZ47qFJenMioKVjZ/aEzHs286
+IxSR/xl/pcqs7rN2nXrpixurazHb+gtTTK/FpRp5PIpM/6zfJd5O2YIyC0TeytuMrKNuFoM7pmRL
+Mon7FhY4futD4tN0SsJiCnMK3UmzV9KwCoWdcTzeo8vAMvMBOSBDGzXRU7Ox7sWTaYI+FrUoRqHe
+6okJ7UO4BUaKhvVZR74bbwEhELn9qdIoyhA5CcoTNs+cra1AdHkrAj80//ogaX3T7mH1urPnMNA3
+I4ZyYUUpSFlob3emLoG+B01vr87ERRORFHAGjx+f+IdpsQ7vw4kZ6+ocYfx6bIrc1gMLnia6Et3U
+VDmrJqMz6nWB2i3ND0/kA9HvFZcba5DFApCTZgIhsUfei5pKgLlVj7WiL8DWM2fafsSntARE60f7
+5li59wzweyuxwHApw0BiLTtIadwjPEjrewl5qW3aqDCYz4ByA4imW0aucnl8CAMhZa634RylsSqi
+Md5mBPfAdOhx3v89WcyWJhKLhZVXGqtrdQtEPREoPHtht+KPZ0/l7DxMYIBpVzgeAVuNVejH38DM
+dyM0SXV89pgR6y3e7UEuFAUCf+D+IOs15xGsIs5XPd7JMG0QA4XN8f+MFrXBsj6IbGB/kE+V9/Yt
+rQE5BwT6dYB9v0lQ7e/JxHwc64B+27bQ3RP+ydOc17KXqQIDAQABo0IwQDAPBgNVHRMBAf8EBTAD
+AQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUxhfQvKjqAkPyGwaZXSuQILnXnOQwDQYJKoZI
+hvcNAQELBQADggIBADRh2Va1EodVTd2jNTFGu6QHcrxfYWLopfsLN7E8trP6KZ1/AvWkyaiTt3px
+KGmPc+FSkNrVvjrlt3ZqVoAh313m6Tqe5T72omnHKgqwGEfcIHB9UqM+WXzBusnIFUBhynLWcKzS
+t/Ac5IYp8M7vaGPQtSCKFWGafoaYtMnCdvvMujAWzKNhxnQT5WvvoxXqA/4Ti2Tk08HS6IT7SdEQ
+TXlm66r99I0xHnAUrdzeZxNMgRVhvLfZkXdxGYFgu/BYpbWcC/ePIlUnwEsBbTuZDdQdm2NnL9Du
+DcpmvJRPpq3t/O5jrFc/ZSXPsoaP0Aj/uHYUbt7lJ+yreLVTubY/6CD50qi+YUbKh4yE8/nxoGib
+Ih6BJpsQBJFxwAYf3KDTuVan45gtf4Od34wrnDKOMpTwATwiKp9Dwi7DmDkHOHv8XgBCH/MyJnmD
+hPbl8MFREsALHgQjDFSlTC9JxUrRtm5gDWv8a4uFJGS3iQ6rJUdbPM9+Sb3H6QrG2vd+DhcI00iX
+0HGS8A85PjRqHH3Y8iKuu2n0M7SmSFXRDw4m6Oy2Cy2nhTXN/VnIn9HNPlopNLk9hM6xZdRZkZFW
+dSHBd575euFgndOtBBj0fOtek49TSiIp+EgrPk2GrFt/ywaZWWDYWGWVjUTR939+J399roD1B0y2
+PpxxVJkES/1Y+Zj0
+-----END CERTIFICATE-----
+
+DigiCert Assured ID Root G2
+===========================
+-----BEGIN CERTIFICATE-----
+MIIDljCCAn6gAwIBAgIQC5McOtY5Z+pnI7/Dr5r0SzANBgkqhkiG9w0BAQsFADBlMQswCQYDVQQG
+EwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3d3cuZGlnaWNlcnQuY29tMSQw
+IgYDVQQDExtEaWdpQ2VydCBBc3N1cmVkIElEIFJvb3QgRzIwHhcNMTMwODAxMTIwMDAwWhcNMzgw
+MTE1MTIwMDAwWjBlMQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQL
+ExB3d3cuZGlnaWNlcnQuY29tMSQwIgYDVQQDExtEaWdpQ2VydCBBc3N1cmVkIElEIFJvb3QgRzIw
+ggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQDZ5ygvUj82ckmIkzTz+GoeMVSAn61UQbVH
+35ao1K+ALbkKz3X9iaV9JPrjIgwrvJUXCzO/GU1BBpAAvQxNEP4HteccbiJVMWWXvdMX0h5i89vq
+bFCMP4QMls+3ywPgym2hFEwbid3tALBSfK+RbLE4E9HpEgjAALAcKxHad3A2m67OeYfcgnDmCXRw
+VWmvo2ifv922ebPynXApVfSr/5Vh88lAbx3RvpO704gqu52/clpWcTs/1PPRCv4o76Pu2ZmvA9OP
+YLfykqGxvYmJHzDNw6YuYjOuFgJ3RFrngQo8p0Quebg/BLxcoIfhG69Rjs3sLPr4/m3wOnyqi+Rn
+lTGNAgMBAAGjQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgGGMB0GA1UdDgQWBBTO
+w0q5mVXyuNtgv6l+vVa1lzan1jANBgkqhkiG9w0BAQsFAAOCAQEAyqVVjOPIQW5pJ6d1Ee88hjZv
+0p3GeDgdaZaikmkuOGybfQTUiaWxMTeKySHMq2zNixya1r9I0jJmwYrA8y8678Dj1JGG0VDjA9tz
+d29KOVPt3ibHtX2vK0LRdWLjSisCx1BL4GnilmwORGYQRI+tBev4eaymG+g3NJ1TyWGqolKvSnAW
+hsI6yLETcDbYz+70CjTVW0z9B5yiutkBclzzTcHdDrEcDcRjvq30FPuJ7KJBDkzMyFdA0G4Dqs0M
+jomZmWzwPDCvON9vvKO+KSAnq3T/EyJ43pdSVR6DtVQgA+6uwE9W3jfMw3+qBCe703e4YtsXfJwo
+IhNzbM8m9Yop5w==
+-----END CERTIFICATE-----
+
+DigiCert Assured ID Root G3
+===========================
+-----BEGIN CERTIFICATE-----
+MIICRjCCAc2gAwIBAgIQC6Fa+h3foLVJRK/NJKBs7DAKBggqhkjOPQQDAzBlMQswCQYDVQQGEwJV
+UzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3d3cuZGlnaWNlcnQuY29tMSQwIgYD
+VQQDExtEaWdpQ2VydCBBc3N1cmVkIElEIFJvb3QgRzMwHhcNMTMwODAxMTIwMDAwWhcNMzgwMTE1
+MTIwMDAwWjBlMQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3
+d3cuZGlnaWNlcnQuY29tMSQwIgYDVQQDExtEaWdpQ2VydCBBc3N1cmVkIElEIFJvb3QgRzMwdjAQ
+BgcqhkjOPQIBBgUrgQQAIgNiAAQZ57ysRGXtzbg/WPuNsVepRC0FFfLvC/8QdJ+1YlJfZn4f5dwb
+RXkLzMZTCp2NXQLZqVneAlr2lSoOjThKiknGvMYDOAdfVdp+CW7if17QRSAPWXYQ1qAk8C3eNvJs
+KTmjQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgGGMB0GA1UdDgQWBBTL0L2p4ZgF
+UaFNN6KDec6NHSrkhDAKBggqhkjOPQQDAwNnADBkAjAlpIFFAmsSS3V0T8gj43DydXLefInwz5Fy
+YZ5eEJJZVrmDxxDnOOlYJjZ91eQ0hjkCMHw2U/Aw5WJjOpnitqM7mzT6HtoQknFekROn3aRukswy
+1vUhZscv6pZjamVFkpUBtA==
+-----END CERTIFICATE-----
+
+DigiCert Global Root G2
+=======================
+-----BEGIN CERTIFICATE-----
+MIIDjjCCAnagAwIBAgIQAzrx5qcRqaC7KGSxHQn65TANBgkqhkiG9w0BAQsFADBhMQswCQYDVQQG
+EwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3d3cuZGlnaWNlcnQuY29tMSAw
+HgYDVQQDExdEaWdpQ2VydCBHbG9iYWwgUm9vdCBHMjAeFw0xMzA4MDExMjAwMDBaFw0zODAxMTUx
+MjAwMDBaMGExCzAJBgNVBAYTAlVTMRUwEwYDVQQKEwxEaWdpQ2VydCBJbmMxGTAXBgNVBAsTEHd3
+dy5kaWdpY2VydC5jb20xIDAeBgNVBAMTF0RpZ2lDZXJ0IEdsb2JhbCBSb290IEcyMIIBIjANBgkq
+hkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEAuzfNNNx7a8myaJCtSnX/RrohCgiN9RlUyfuI2/Ou8jqJ
+kTx65qsGGmvPrC3oXgkkRLpimn7Wo6h+4FR1IAWsULecYxpsMNzaHxmx1x7e/dfgy5SDN67sH0NO
+3Xss0r0upS/kqbitOtSZpLYl6ZtrAGCSYP9PIUkY92eQq2EGnI/yuum06ZIya7XzV+hdG82MHauV
+BJVJ8zUtluNJbd134/tJS7SsVQepj5WztCO7TG1F8PapspUwtP1MVYwnSlcUfIKdzXOS0xZKBgyM
+UNGPHgm+F6HmIcr9g+UQvIOlCsRnKPZzFBQ9RnbDhxSJITRNrw9FDKZJobq7nMWxM4MphQIDAQAB
+o0IwQDAPBgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBhjAdBgNVHQ4EFgQUTiJUIBiV5uNu
+5g/6+rkS7QYXjzkwDQYJKoZIhvcNAQELBQADggEBAGBnKJRvDkhj6zHd6mcY1Yl9PMWLSn/pvtsr
+F9+wX3N3KjITOYFnQoQj8kVnNeyIv/iPsGEMNKSuIEyExtv4NeF22d+mQrvHRAiGfzZ0JFrabA0U
+WTW98kndth/Jsw1HKj2ZL7tcu7XUIOGZX1NGFdtom/DzMNU+MeKNhJ7jitralj41E6Vf8PlwUHBH
+QRFXGU7Aj64GxJUTFy8bJZ918rGOmaFvE7FBcf6IKshPECBV1/MUReXgRPTqh5Uykw7+U0b6LJ3/
+iyK5S9kJRaTepLiaWN0bfVKfjllDiIGknibVb63dDcY3fe0Dkhvld1927jyNxF1WW6LZZm6zNTfl
+MrY=
+-----END CERTIFICATE-----
+
+DigiCert Global Root G3
+=======================
+-----BEGIN CERTIFICATE-----
+MIICPzCCAcWgAwIBAgIQBVVWvPJepDU1w6QP1atFcjAKBggqhkjOPQQDAzBhMQswCQYDVQQGEwJV
+UzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3d3cuZGlnaWNlcnQuY29tMSAwHgYD
+VQQDExdEaWdpQ2VydCBHbG9iYWwgUm9vdCBHMzAeFw0xMzA4MDExMjAwMDBaFw0zODAxMTUxMjAw
+MDBaMGExCzAJBgNVBAYTAlVTMRUwEwYDVQQKEwxEaWdpQ2VydCBJbmMxGTAXBgNVBAsTEHd3dy5k
+aWdpY2VydC5jb20xIDAeBgNVBAMTF0RpZ2lDZXJ0IEdsb2JhbCBSb290IEczMHYwEAYHKoZIzj0C
+AQYFK4EEACIDYgAE3afZu4q4C/sLfyHS8L6+c/MzXRq8NOrexpu80JX28MzQC7phW1FGfp4tn+6O
+YwwX7Adw9c+ELkCDnOg/QW07rdOkFFk2eJ0DQ+4QE2xy3q6Ip6FrtUPOZ9wj/wMco+I+o0IwQDAP
+BgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB/wQEAwIBhjAdBgNVHQ4EFgQUs9tIpPmhxdiuNkHMEWNp
+Yim8S8YwCgYIKoZIzj0EAwMDaAAwZQIxAK288mw/EkrRLTnDCgmXc/SINoyIJ7vmiI1Qhadj+Z4y
+3maTD/HMsQmP3Wyr+mt/oAIwOWZbwmSNuJ5Q3KjVSaLtx9zRSX8XAbjIho9OjIgrqJqpisXRAL34
+VOKa5Vt8sycX
+-----END CERTIFICATE-----
+
+DigiCert Trusted Root G4
+========================
+-----BEGIN CERTIFICATE-----
+MIIFkDCCA3igAwIBAgIQBZsbV56OITLiOQe9p3d1XDANBgkqhkiG9w0BAQwFADBiMQswCQYDVQQG
+EwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3d3cuZGlnaWNlcnQuY29tMSEw
+HwYDVQQDExhEaWdpQ2VydCBUcnVzdGVkIFJvb3QgRzQwHhcNMTMwODAxMTIwMDAwWhcNMzgwMTE1
+MTIwMDAwWjBiMQswCQYDVQQGEwJVUzEVMBMGA1UEChMMRGlnaUNlcnQgSW5jMRkwFwYDVQQLExB3
+d3cuZGlnaWNlcnQuY29tMSEwHwYDVQQDExhEaWdpQ2VydCBUcnVzdGVkIFJvb3QgRzQwggIiMA0G
+CSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQC/5pBzaN675F1KPDAiMGkz7MKnJS7JIT3yithZwuEp
+pz1Yq3aaza57G4QNxDAf8xukOBbrVsaXbR2rsnnyyhHS5F/WBTxSD1Ifxp4VpX6+n6lXFllVcq9o
+k3DCsrp1mWpzMpTREEQQLt+C8weE5nQ7bXHiLQwb7iDVySAdYyktzuxeTsiT+CFhmzTrBcZe7Fsa
+vOvJz82sNEBfsXpm7nfISKhmV1efVFiODCu3T6cw2Vbuyntd463JT17lNecxy9qTXtyOj4DatpGY
+QJB5w3jHtrHEtWoYOAMQjdjUN6QuBX2I9YI+EJFwq1WCQTLX2wRzKm6RAXwhTNS8rhsDdV14Ztk6
+MUSaM0C/CNdaSaTC5qmgZ92kJ7yhTzm1EVgX9yRcRo9k98FpiHaYdj1ZXUJ2h4mXaXpI8OCiEhtm
+mnTK3kse5w5jrubU75KSOp493ADkRSWJtppEGSt+wJS00mFt6zPZxd9LBADMfRyVw4/3IbKyEbe7
+f/LVjHAsQWCqsWMYRJUadmJ+9oCw++hkpjPRiQfhvbfmQ6QYuKZ3AeEPlAwhHbJUKSWJbOUOUlFH
+dL4mrLZBdd56rF+NP8m800ERElvlEFDrMcXKchYiCd98THU/Y+whX8QgUWtvsauGi0/C1kVfnSD8
+oR7FwI+isX4KJpn15GkvmB0t9dmpsh3lGwIDAQABo0IwQDAPBgNVHRMBAf8EBTADAQH/MA4GA1Ud
+DwEB/wQEAwIBhjAdBgNVHQ4EFgQU7NfjgtJxXWRM3y5nP+e6mK4cD08wDQYJKoZIhvcNAQEMBQAD
+ggIBALth2X2pbL4XxJEbw6GiAI3jZGgPVs93rnD5/ZpKmbnJeFwMDF/k5hQpVgs2SV1EY+CtnJYY
+ZhsjDT156W1r1lT40jzBQ0CuHVD1UvyQO7uYmWlrx8GnqGikJ9yd+SeuMIW59mdNOj6PWTkiU0Tr
+yF0Dyu1Qen1iIQqAyHNm0aAFYF/opbSnr6j3bTWcfFqK1qI4mfN4i/RN0iAL3gTujJtHgXINwBQy
+7zBZLq7gcfJW5GqXb5JQbZaNaHqasjYUegbyJLkJEVDXCLG4iXqEI2FCKeWjzaIgQdfRnGTZ6iah
+ixTXTBmyUEFxPT9NcCOGDErcgdLMMpSEDQgJlxxPwO5rIHQw0uA5NBCFIRUBCOhVMt5xSdkoF1BN
+5r5N0XWs0Mr7QbhDparTwwVETyw2m+L64kW4I1NsBm9nVX9GtUw/bihaeSbSpKhil9Ie4u1Ki7wb
+/UdKDd9nZn6yW0HQO+T0O/QEY+nvwlQAUaCKKsnOeMzV6ocEGLPOr0mIr/OSmbaz5mEP0oUA51Aa
+5BuVnRmhuZyxm7EAHu/QD09CbMkKvO5D+jpxpchNJqU1/YldvIViHTLSoCtU7ZpXwdv6EM8Zt4tK
+G48BtieVU+i2iW1bvGjUI+iLUaJW+fCmgKDWHrO8Dw9TdSmq6hN35N6MgSGtBxBHEa2HPQfRdbzP
+82Z+
+-----END CERTIFICATE-----
+
+COMODO RSA Certification Authority
+==================================
+-----BEGIN CERTIFICATE-----
+MIIF2DCCA8CgAwIBAgIQTKr5yttjb+Af907YWwOGnTANBgkqhkiG9w0BAQwFADCBhTELMAkGA1UE
+BhMCR0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4GA1UEBxMHU2FsZm9yZDEaMBgG
+A1UEChMRQ09NT0RPIENBIExpbWl0ZWQxKzApBgNVBAMTIkNPTU9ETyBSU0EgQ2VydGlmaWNhdGlv
+biBBdXRob3JpdHkwHhcNMTAwMTE5MDAwMDAwWhcNMzgwMTE4MjM1OTU5WjCBhTELMAkGA1UEBhMC
+R0IxGzAZBgNVBAgTEkdyZWF0ZXIgTWFuY2hlc3RlcjEQMA4GA1UEBxMHU2FsZm9yZDEaMBgGA1UE
+ChMRQ09NT0RPIENBIExpbWl0ZWQxKzApBgNVBAMTIkNPTU9ETyBSU0EgQ2VydGlmaWNhdGlvbiBB
+dXRob3JpdHkwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCR6FSS0gpWsawNJN3Fz0Rn
+dJkrN6N9I3AAcbxT38T6KhKPS38QVr2fcHK3YX/JSw8Xpz3jsARh7v8Rl8f0hj4K+j5c+ZPmNHrZ
+FGvnnLOFoIJ6dq9xkNfs/Q36nGz637CC9BR++b7Epi9Pf5l/tfxnQ3K9DADWietrLNPtj5gcFKt+
+5eNu/Nio5JIk2kNrYrhV/erBvGy2i/MOjZrkm2xpmfh4SDBF1a3hDTxFYPwyllEnvGfDyi62a+pG
+x8cgoLEfZd5ICLqkTqnyg0Y3hOvozIFIQ2dOciqbXL1MGyiKXCJ7tKuY2e7gUYPDCUZObT6Z+pUX
+2nwzV0E8jVHtC7ZcryxjGt9XyD+86V3Em69FmeKjWiS0uqlWPc9vqv9JWL7wqP/0uK3pN/u6uPQL
+OvnoQ0IeidiEyxPx2bvhiWC4jChWrBQdnArncevPDt09qZahSL0896+1DSJMwBGB7FY79tOi4lu3
+sgQiUpWAk2nojkxl8ZEDLXB0AuqLZxUpaVICu9ffUGpVRr+goyhhf3DQw6KqLCGqR84onAZFdr+C
+GCe01a60y1Dma/RMhnEw6abfFobg2P9A3fvQQoh/ozM6LlweQRGBY84YcWsr7KaKtzFcOmpH4MN5
+WdYgGq/yapiqcrxXStJLnbsQ/LBMQeXtHT1eKJ2czL+zUdqnR+WEUwIDAQABo0IwQDAdBgNVHQ4E
+FgQUu69+Aj36pvE8hI6t7jiY7NkyMtQwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8w
+DQYJKoZIhvcNAQEMBQADggIBAArx1UaEt65Ru2yyTUEUAJNMnMvlwFTPoCWOAvn9sKIN9SCYPBMt
+rFaisNZ+EZLpLrqeLppysb0ZRGxhNaKatBYSaVqM4dc+pBroLwP0rmEdEBsqpIt6xf4FpuHA1sj+
+nq6PK7o9mfjYcwlYRm6mnPTXJ9OV2jeDchzTc+CiR5kDOF3VSXkAKRzH7JsgHAckaVd4sjn8OoSg
+tZx8jb8uk2IntznaFxiuvTwJaP+EmzzV1gsD41eeFPfR60/IvYcjt7ZJQ3mFXLrrkguhxuhoqEwW
+sRqZCuhTLJK7oQkYdQxlqHvLI7cawiiFwxv/0Cti76R7CZGYZ4wUAc1oBmpjIXUDgIiKboHGhfKp
+pC3n9KUkEEeDys30jXlYsQab5xoq2Z0B15R97QNKyvDb6KkBPvVWmckejkk9u+UJueBPSZI9FoJA
+zMxZxuY67RIuaTxslbH9qh17f4a+Hg4yRvv7E491f0yLS0Zj/gA0QHDBw7mh3aZw4gSzQbzpgJHq
+ZJx64SIDqZxubw5lT2yHh17zbqD5daWbQOhTsiedSrnAdyGN/4fy3ryM7xfft0kL0fJuMAsaDk52
+7RH89elWsn2/x20Kk4yl0MC2Hb46TpSi125sC8KKfPog88Tk5c0NqMuRkrF8hey1FGlmDoLnzc7I
+LaZRfyHBNVOFBkpdn627G190
+-----END CERTIFICATE-----
+
+USERTrust RSA Certification Authority
+=====================================
+-----BEGIN CERTIFICATE-----
+MIIF3jCCA8agAwIBAgIQAf1tMPyjylGoG7xkDjUDLTANBgkqhkiG9w0BAQwFADCBiDELMAkGA1UE
+BhMCVVMxEzARBgNVBAgTCk5ldyBKZXJzZXkxFDASBgNVBAcTC0plcnNleSBDaXR5MR4wHAYDVQQK
+ExVUaGUgVVNFUlRSVVNUIE5ldHdvcmsxLjAsBgNVBAMTJVVTRVJUcnVzdCBSU0EgQ2VydGlmaWNh
+dGlvbiBBdXRob3JpdHkwHhcNMTAwMjAxMDAwMDAwWhcNMzgwMTE4MjM1OTU5WjCBiDELMAkGA1UE
+BhMCVVMxEzARBgNVBAgTCk5ldyBKZXJzZXkxFDASBgNVBAcTC0plcnNleSBDaXR5MR4wHAYDVQQK
+ExVUaGUgVVNFUlRSVVNUIE5ldHdvcmsxLjAsBgNVBAMTJVVTRVJUcnVzdCBSU0EgQ2VydGlmaWNh
+dGlvbiBBdXRob3JpdHkwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCAEmUXNg7D2wiz
+0KxXDXbtzSfTTK1Qg2HiqiBNCS1kCdzOiZ/MPans9s/B3PHTsdZ7NygRK0faOca8Ohm0X6a9fZ2j
+Y0K2dvKpOyuR+OJv0OwWIJAJPuLodMkYtJHUYmTbf6MG8YgYapAiPLz+E/CHFHv25B+O1ORRxhFn
+RghRy4YUVD+8M/5+bJz/Fp0YvVGONaanZshyZ9shZrHUm3gDwFA66Mzw3LyeTP6vBZY1H1dat//O
++T23LLb2VN3I5xI6Ta5MirdcmrS3ID3KfyI0rn47aGYBROcBTkZTmzNg95S+UzeQc0PzMsNT79uq
+/nROacdrjGCT3sTHDN/hMq7MkztReJVni+49Vv4M0GkPGw/zJSZrM233bkf6c0Plfg6lZrEpfDKE
+Y1WJxA3Bk1QwGROs0303p+tdOmw1XNtB1xLaqUkL39iAigmTYo61Zs8liM2EuLE/pDkP2QKe6xJM
+lXzzawWpXhaDzLhn4ugTncxbgtNMs+1b/97lc6wjOy0AvzVVdAlJ2ElYGn+SNuZRkg7zJn0cTRe8
+yexDJtC/QV9AqURE9JnnV4eeUB9XVKg+/XRjL7FQZQnmWEIuQxpMtPAlR1n6BB6T1CZGSlCBst6+
+eLf8ZxXhyVeEHg9j1uliutZfVS7qXMYoCAQlObgOK6nyTJccBz8NUvXt7y+CDwIDAQABo0IwQDAd
+BgNVHQ4EFgQUU3m/WqorSs9UgOHYm8Cd8rIDZsswDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQF
+MAMBAf8wDQYJKoZIhvcNAQEMBQADggIBAFzUfA3P9wF9QZllDHPFUp/L+M+ZBn8b2kMVn54CVVeW
+FPFSPCeHlCjtHzoBN6J2/FNQwISbxmtOuowhT6KOVWKR82kV2LyI48SqC/3vqOlLVSoGIG1VeCkZ
+7l8wXEskEVX/JJpuXior7gtNn3/3ATiUFJVDBwn7YKnuHKsSjKCaXqeYalltiz8I+8jRRa8YFWSQ
+Eg9zKC7F4iRO/Fjs8PRF/iKz6y+O0tlFYQXBl2+odnKPi4w2r78NBc5xjeambx9spnFixdjQg3IM
+8WcRiQycE0xyNN+81XHfqnHd4blsjDwSXWXavVcStkNr/+XeTWYRUc+ZruwXtuhxkYzeSf7dNXGi
+FSeUHM9h4ya7b6NnJSFd5t0dCy5oGzuCr+yDZ4XUmFF0sbmZgIn/f3gZXHlKYC6SQK5MNyosycdi
+yA5d9zZbyuAlJQG03RoHnHcAP9Dc1ew91Pq7P8yF1m9/qS3fuQL39ZeatTXaw2ewh0qpKJ4jjv9c
+J2vhsE/zB+4ALtRZh8tSQZXq9EfX7mRBVXyNWQKV3WKdwrnuWih0hKWbt5DHDAff9Yk2dDLWKMGw
+sAvgnEzDHNb842m1R0aBL6KCq9NjRHDEjf8tM7qtj3u1cIiuPhnPQCjY/MiQu12ZIvVS5ljFH4gx
+Q+6IHdfGjjxDah2nGN59PRbxYvnKkKj9
+-----END CERTIFICATE-----
+
+USERTrust ECC Certification Authority
+=====================================
+-----BEGIN CERTIFICATE-----
+MIICjzCCAhWgAwIBAgIQXIuZxVqUxdJxVt7NiYDMJjAKBggqhkjOPQQDAzCBiDELMAkGA1UEBhMC
+VVMxEzARBgNVBAgTCk5ldyBKZXJzZXkxFDASBgNVBAcTC0plcnNleSBDaXR5MR4wHAYDVQQKExVU
+aGUgVVNFUlRSVVNUIE5ldHdvcmsxLjAsBgNVBAMTJVVTRVJUcnVzdCBFQ0MgQ2VydGlmaWNhdGlv
+biBBdXRob3JpdHkwHhcNMTAwMjAxMDAwMDAwWhcNMzgwMTE4MjM1OTU5WjCBiDELMAkGA1UEBhMC
+VVMxEzARBgNVBAgTCk5ldyBKZXJzZXkxFDASBgNVBAcTC0plcnNleSBDaXR5MR4wHAYDVQQKExVU
+aGUgVVNFUlRSVVNUIE5ldHdvcmsxLjAsBgNVBAMTJVVTRVJUcnVzdCBFQ0MgQ2VydGlmaWNhdGlv
+biBBdXRob3JpdHkwdjAQBgcqhkjOPQIBBgUrgQQAIgNiAAQarFRaqfloI+d61SRvU8Za2EurxtW2
+0eZzca7dnNYMYf3boIkDuAUU7FfO7l0/4iGzzvfUinngo4N+LZfQYcTxmdwlkWOrfzCjtHDix6Ez
+nPO/LlxTsV+zfTJ/ijTjeXmjQjBAMB0GA1UdDgQWBBQ64QmG1M8ZwpZ2dEl23OA1xmNjmjAOBgNV
+HQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAKBggqhkjOPQQDAwNoADBlAjA2Z6EWCNzklwBB
+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-----
+MIICHjCCAaSgAwIBAgIRYFlJ4CYuu1X5CneKcflK2GwwCgYIKoZIzj0EAwMwUDEkMCIGA1UECxMb
+R2xvYmFsU2lnbiBFQ0MgUm9vdCBDQSAtIFI1MRMwEQYDVQQKEwpHbG9iYWxTaWduMRMwEQYDVQQD
+EwpHbG9iYWxTaWduMB4XDTEyMTExMzAwMDAwMFoXDTM4MDExOTAzMTQwN1owUDEkMCIGA1UECxMb
+R2xvYmFsU2lnbiBFQ0MgUm9vdCBDQSAtIFI1MRMwEQYDVQQKEwpHbG9iYWxTaWduMRMwEQYDVQQD
+EwpHbG9iYWxTaWduMHYwEAYHKoZIzj0CAQYFK4EEACIDYgAER0UOlvt9Xb/pOdEh+J8LttV7HpI6
+SFkc8GIxLcB6KP4ap1yztsyX50XUWPrRd21DosCHZTQKH3rd6zwzocWdTaRvQZU4f8kehOvRnkmS
+h5SHDDqFSmafnVmTTZdhBoZKo0IwQDAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAd
+BgNVHQ4EFgQUPeYpSJvqB8ohREom3m7e0oPQn1kwCgYIKoZIzj0EAwMDaAAwZQIxAOVpEslu28Yx
+uglB4Zf4+/2a4n0Sye18ZNPLBSWLVtmg515dTguDnFt2KaAJJiFqYgIwcdK1j1zqO+F4CYWodZI7
+yFz9SO8NdCKoCOJuxUnOxwy8p2Fp8fc74SrL+SvzZpA3
+-----END CERTIFICATE-----
+
+Staat der Nederlanden Root CA - G3
+==================================
+-----BEGIN CERTIFICATE-----
+MIIFdDCCA1ygAwIBAgIEAJiiOTANBgkqhkiG9w0BAQsFADBaMQswCQYDVQQGEwJOTDEeMBwGA1UE
+CgwVU3RhYXQgZGVyIE5lZGVybGFuZGVuMSswKQYDVQQDDCJTdGFhdCBkZXIgTmVkZXJsYW5kZW4g
+Um9vdCBDQSAtIEczMB4XDTEzMTExNDExMjg0MloXDTI4MTExMzIzMDAwMFowWjELMAkGA1UEBhMC
+TkwxHjAcBgNVBAoMFVN0YWF0IGRlciBOZWRlcmxhbmRlbjErMCkGA1UEAwwiU3RhYXQgZGVyIE5l
+ZGVybGFuZGVuIFJvb3QgQ0EgLSBHMzCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAL4y
+olQPcPssXFnrbMSkUeiFKrPMSjTysF/zDsccPVMeiAho2G89rcKezIJnByeHaHE6n3WWIkYFsO2t
+x1ueKt6c/DrGlaf1F2cY5y9JCAxcz+bMNO14+1Cx3Gsy8KL+tjzk7FqXxz8ecAgwoNzFs21v0IJy
+EavSgWhZghe3eJJg+szeP4TrjTgzkApyI/o1zCZxMdFyKJLZWyNtZrVtB0LrpjPOktvA9mxjeM3K
+Tj215VKb8b475lRgsGYeCasH/lSJEULR9yS6YHgamPfJEf0WwTUaVHXvQ9Plrk7O53vDxk5hUUur
+mkVLoR9BvUhTFXFkC4az5S6+zqQbwSmEorXLCCN2QyIkHxcE1G6cxvx/K2Ya7Irl1s9N9WMJtxU5
+1nus6+N86U78dULI7ViVDAZCopz35HCz33JvWjdAidiFpNfxC95DGdRKWCyMijmev4SH8RY7Ngzp
+07TKbBlBUgmhHbBqv4LvcFEhMtwFdozL92TkA1CvjJFnq8Xy7ljY3r735zHPbMk7ccHViLVlvMDo
+FxcHErVc0qsgk7TmgoNwNsXNo42ti+yjwUOH5kPiNL6VizXtBznaqB16nzaeErAMZRKQFWDZJkBE
+41ZgpRDUajz9QdwOWke275dhdU/Z/seyHdTtXUmzqWrLZoQT1Vyg3N9udwbRcXXIV2+vD3dbAgMB
+AAGjQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgEGMB0GA1UdDgQWBBRUrfrHkleu
+yjWcLhL75LpdINyUVzANBgkqhkiG9w0BAQsFAAOCAgEAMJmdBTLIXg47mAE6iqTnB/d6+Oea31BD
+U5cqPco8R5gu4RV78ZLzYdqQJRZlwJ9UXQ4DO1t3ApyEtg2YXzTdO2PCwyiBwpwpLiniyMMB8jPq
+KqrMCQj3ZWfGzd/TtiunvczRDnBfuCPRy5FOCvTIeuXZYzbB1N/8Ipf3YF3qKS9Ysr1YvY2WTxB1
+v0h7PVGHoTx0IsL8B3+A3MSs/mrBcDCw6Y5p4ixpgZQJut3+TcCDjJRYwEYgr5wfAvg1VUkvRtTA
+8KCWAg8zxXHzniN9lLf9OtMJgwYh/WA9rjLA0u6NpvDntIJ8CsxwyXmA+P5M9zWEGYox+wrZ13+b
+8KKaa8MFSu1BYBQw0aoRQm7TIwIEC8Zl3d1Sd9qBa7Ko+gE4uZbqKmxnl4mUnrzhVNXkanjvSr0r
+mj1AfsbAddJu+2gw7OyLnflJNZoaLNmzlTnVHpL3prllL+U9bTpITAjc5CgSKL59NVzq4BZ+Extq
+1z7XnvwtdbLBFNUjA9tbbws+eC8N3jONFrdI54OagQ97wUNNVQQXOEpR1VmiiXTTn74eS9fGbbeI
+JG9gkaSChVtWQbzQRKtqE77RLFi3EjNYsjdj3BP1lB0/QFH1T/U67cjF68IeHRaVesd+QnGTbksV
+tzDfqu1XhUisHWrdOWnk4Xl4vs4Fv6EM94B7IWcnMFk=
+-----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-----
+MIIFYDCCA0igAwIBAgIQCgFCgAAAAUUjyES1AAAAAjANBgkqhkiG9w0BAQsFADBKMQswCQYDVQQG
+EwJVUzESMBAGA1UEChMJSWRlblRydXN0MScwJQYDVQQDEx5JZGVuVHJ1c3QgQ29tbWVyY2lhbCBS
+b290IENBIDEwHhcNMTQwMTE2MTgxMjIzWhcNMzQwMTE2MTgxMjIzWjBKMQswCQYDVQQGEwJVUzES
+MBAGA1UEChMJSWRlblRydXN0MScwJQYDVQQDEx5JZGVuVHJ1c3QgQ29tbWVyY2lhbCBSb290IENB
+IDEwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQCnUBneP5k91DNG8W9RYYKyqU+PZ4ld
+hNlT3Qwo2dfw/66VQ3KZ+bVdfIrBQuExUHTRgQ18zZshq0PirK1ehm7zCYofWjK9ouuU+ehcCuz/
+mNKvcbO0U59Oh++SvL3sTzIwiEsXXlfEU8L2ApeN2WIrvyQfYo3fw7gpS0l4PJNgiCL8mdo2yMKi
+1CxUAGc1bnO/AljwpN3lsKImesrgNqUZFvX9t++uP0D1bVoE/c40yiTcdCMbXTMTEl3EASX2MN0C
+XZ/g1Ue9tOsbobtJSdifWwLziuQkkORiT0/Br4sOdBeo0XKIanoBScy0RnnGF7HamB4HWfp1IYVl
+3ZBWzvurpWCdxJ35UrCLvYf5jysjCiN2O/cz4ckA82n5S6LgTrx+kzmEB/dEcH7+B1rlsazRGMzy
+NeVJSQjKVsk9+w8YfYs7wRPCTY/JTw436R+hDmrfYi7LNQZReSzIJTj0+kuniVyc0uMNOYZKdHzV
+WYfCP04MXFL0PfdSgvHqo6z9STQaKPNBiDoT7uje/5kdX7rL6B7yuVBgwDHTc+XvvqDtMwt0viAg
+xGds8AgDelWAf0ZOlqf0Hj7h9tgJ4TNkK2PXMl6f+cB7D3hvl7yTmvmcEpB4eoCHFddydJxVdHix
+uuFucAS6T6C6aMN7/zHwcz09lCqxC0EOoP5NiGVreTO01wIDAQABo0IwQDAOBgNVHQ8BAf8EBAMC
+AQYwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQU7UQZwNPwBovupHu+QucmVMiONnYwDQYJKoZI
+hvcNAQELBQADggIBAA2ukDL2pkt8RHYZYR4nKM1eVO8lvOMIkPkp165oCOGUAFjvLi5+U1KMtlwH
+6oi6mYtQlNeCgN9hCQCTrQ0U5s7B8jeUeLBfnLOic7iPBZM4zY0+sLj7wM+x8uwtLRvM7Kqas6pg
+ghstO8OEPVeKlh6cdbjTMM1gCIOQ045U8U1mwF10A0Cj7oV+wh93nAbowacYXVKV7cndJZ5t+qnt
+ozo00Fl72u1Q8zW/7esUTTHHYPTa8Yec4kjixsU3+wYQ+nVZZjFHKdp2mhzpgq7vmrlR94gjmmmV
+YjzlVYA211QC//G5Xc7UI2/YRYRKW2XviQzdFKcgyxilJbQN+QHwotL0AMh0jqEqSI5l2xPE4iUX
+feu+h1sXIFRRk0pTAwvsXcoz7WL9RccvW9xYoIA55vrX/hMUpu09lEpCdNTDd1lzzY9GvlU47/ro
+kTLql1gEIt44w8y8bckzOmoKaT+gyOpyj4xjhiO9bTyWnpXgSUyqorkqG5w2gXjtw+hG4iZZRHUe
+2XWJUc0QhJ1hYMtd+ZciTY6Y5uN/9lu7rs3KSoFrXgvzUeF0K+l+J6fZmUlO+KWA2yUPHGNiiskz
+Z2s8EIPGrd6ozRaOjfAHN3Gf8qv8QfXBi+wAN10J5U6A7/qxXDgGpRtK4dw4LTzcqx+QGtVKnO7R
+cGzM7vRX+Bi6hG6H
+-----END CERTIFICATE-----
+
+IdenTrust Public Sector Root CA 1
+=================================
+-----BEGIN CERTIFICATE-----
+MIIFZjCCA06gAwIBAgIQCgFCgAAAAUUjz0Z8AAAAAjANBgkqhkiG9w0BAQsFADBNMQswCQYDVQQG
+EwJVUzESMBAGA1UEChMJSWRlblRydXN0MSowKAYDVQQDEyFJZGVuVHJ1c3QgUHVibGljIFNlY3Rv
+ciBSb290IENBIDEwHhcNMTQwMTE2MTc1MzMyWhcNMzQwMTE2MTc1MzMyWjBNMQswCQYDVQQGEwJV
+UzESMBAGA1UEChMJSWRlblRydXN0MSowKAYDVQQDEyFJZGVuVHJ1c3QgUHVibGljIFNlY3RvciBS
+b290IENBIDEwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQC2IpT8pEiv6EdrCvsnduTy
+P4o7ekosMSqMjbCpwzFrqHd2hCa2rIFCDQjrVVi7evi8ZX3yoG2LqEfpYnYeEe4IFNGyRBb06tD6
+Hi9e28tzQa68ALBKK0CyrOE7S8ItneShm+waOh7wCLPQ5CQ1B5+ctMlSbdsHyo+1W/CD80/HLaXI
+rcuVIKQxKFdYWuSNG5qrng0M8gozOSI5Cpcu81N3uURF/YTLNiCBWS2ab21ISGHKTN9T0a9SvESf
+qy9rg3LvdYDaBjMbXcjaY8ZNzaxmMc3R3j6HEDbhuaR672BQssvKplbgN6+rNBM5Jeg5ZuSYeqoS
+mJxZZoY+rfGwyj4GD3vwEUs3oERte8uojHH01bWRNszwFcYr3lEXsZdMUD2xlVl8BX0tIdUAvwFn
+ol57plzy9yLxkA2T26pEUWbMfXYD62qoKjgZl3YNa4ph+bz27nb9cCvdKTz4Ch5bQhyLVi9VGxyh
+LrXHFub4qjySjmm2AcG1hp2JDws4lFTo6tyePSW8Uybt1as5qsVATFSrsrTZ2fjXctscvG29ZV/v
+iDUqZi/u9rNl8DONfJhBaUYPQxxp+pu10GFqzcpL2UyQRqsVWaFHVCkugyhfHMKiq3IXAAaOReyL
+4jM9f9oZRORicsPfIsbyVtTdX5Vy7W1f90gDW/3FKqD2cyOEEBsB5wIDAQABo0IwQDAOBgNVHQ8B
+Af8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB/zAdBgNVHQ4EFgQU43HgntinQtnbcZFrlJPrw6PRFKMw
+DQYJKoZIhvcNAQELBQADggIBAEf63QqwEZE4rU1d9+UOl1QZgkiHVIyqZJnYWv6IAcVYpZmxI1Qj
+t2odIFflAWJBF9MJ23XLblSQdf4an4EKwt3X9wnQW3IV5B4Jaj0z8yGa5hV+rVHVDRDtfULAj+7A
+mgjVQdZcDiFpboBhDhXAuM/FSRJSzL46zNQuOAXeNf0fb7iAaJg9TaDKQGXSc3z1i9kKlT/YPyNt
+GtEqJBnZhbMX73huqVjRI9PHE+1yJX9dsXNw0H8GlwmEKYBhHfpe/3OsoOOJuBxxFcbeMX8S3OFt
+m6/n6J91eEyrRjuazr8FGF1NFTwWmhlQBJqymm9li1JfPFgEKCXAZmExfrngdbkaqIHWchezxQMx
+NRF4eKLg6TCMf4DfWN88uieW4oA0beOY02QnrEh+KHdcxiVhJfiFDGX6xDIvpZgF5PgLZxYWxoK4
+Mhn5+bl53B/N66+rDt0b20XkeucC4pVd/GnwU2lhlXV5C15V5jgclKlZM57IcXR5f1GJtshquDDI
+ajjDbp7hNxbqBWJMWxJH7ae0s1hWx0nzfxJoCTFx8G34Tkf71oXuxVhAGaQdp/lLQzfcaFpPz+vC
+ZHTetBXZ9FRUGi8c15dxVJCO2SCdUyt/q4/i6jC8UDfv8Ue1fXwsBOxonbRJRBD0ckscZOf85muQ
+3Wl9af0AVqW3rLatt8o+Ae+c
+-----END CERTIFICATE-----
+
+Entrust Root Certification Authority - G2
+=========================================
+-----BEGIN CERTIFICATE-----
+MIIEPjCCAyagAwIBAgIESlOMKDANBgkqhkiG9w0BAQsFADCBvjELMAkGA1UEBhMCVVMxFjAUBgNV
+BAoTDUVudHJ1c3QsIEluYy4xKDAmBgNVBAsTH1NlZSB3d3cuZW50cnVzdC5uZXQvbGVnYWwtdGVy
+bXMxOTA3BgNVBAsTMChjKSAyMDA5IEVudHJ1c3QsIEluYy4gLSBmb3IgYXV0aG9yaXplZCB1c2Ug
+b25seTEyMDAGA1UEAxMpRW50cnVzdCBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5IC0gRzIw
+HhcNMDkwNzA3MTcyNTU0WhcNMzAxMjA3MTc1NTU0WjCBvjELMAkGA1UEBhMCVVMxFjAUBgNVBAoT
+DUVudHJ1c3QsIEluYy4xKDAmBgNVBAsTH1NlZSB3d3cuZW50cnVzdC5uZXQvbGVnYWwtdGVybXMx
+OTA3BgNVBAsTMChjKSAyMDA5IEVudHJ1c3QsIEluYy4gLSBmb3IgYXV0aG9yaXplZCB1c2Ugb25s
+eTEyMDAGA1UEAxMpRW50cnVzdCBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5IC0gRzIwggEi
+MA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQC6hLZy254Ma+KZ6TABp3bqMriVQRrJ2mFOWHLP
+/vaCeb9zYQYKpSfYs1/TRU4cctZOMvJyig/3gxnQaoCAAEUesMfnmr8SVycco2gvCoe9amsOXmXz
+HHfV1IWNcCG0szLni6LVhjkCsbjSR87kyUnEO6fe+1R9V77w6G7CebI6C1XiUJgWMhNcL3hWwcKU
+s/Ja5CeanyTXxuzQmyWC48zCxEXFjJd6BmsqEZ+pCm5IO2/b1BEZQvePB7/1U1+cPvQXLOZprE4y
+TGJ36rfo5bs0vBmLrpxR57d+tVOxMyLlbc9wPBr64ptntoP0jaWvYkxN4FisZDQSA/i2jZRjJKRx
+AgMBAAGjQjBAMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBRqciZ6
+0B7vfec7aVHUbI2fkBJmqzANBgkqhkiG9w0BAQsFAAOCAQEAeZ8dlsa2eT8ijYfThwMEYGprmi5Z
+iXMRrEPR9RP/jTkrwPK9T3CMqS/qF8QLVJ7UG5aYMzyorWKiAHarWWluBh1+xLlEjZivEtRh2woZ
+Rkfz6/djwUAFQKXSt/S1mja/qYh2iARVBCuch38aNzx+LaUa2NSJXsq9rD1s2G2v1fN2D807iDgi
+nWyTmsQ9v4IbZT+mD12q/OWyFcq1rca8PdCE6OoGcrBNOTJ4vz4RnAuknZoh8/CbCzB428Hch0P+
+vGOaysXCHMnHjf87ElgI5rY97HosTvuDls4MPGmHVHOkc8KT/1EQrBVUAdj8BbGJoX90g5pJ19xO
+e4pIb4tF9g==
+-----END CERTIFICATE-----
+
+Entrust Root Certification Authority - EC1
+==========================================
+-----BEGIN CERTIFICATE-----
+MIIC+TCCAoCgAwIBAgINAKaLeSkAAAAAUNCR+TAKBggqhkjOPQQDAzCBvzELMAkGA1UEBhMCVVMx
+FjAUBgNVBAoTDUVudHJ1c3QsIEluYy4xKDAmBgNVBAsTH1NlZSB3d3cuZW50cnVzdC5uZXQvbGVn
+YWwtdGVybXMxOTA3BgNVBAsTMChjKSAyMDEyIEVudHJ1c3QsIEluYy4gLSBmb3IgYXV0aG9yaXpl
+ZCB1c2Ugb25seTEzMDEGA1UEAxMqRW50cnVzdCBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5
+IC0gRUMxMB4XDTEyMTIxODE1MjUzNloXDTM3MTIxODE1NTUzNlowgb8xCzAJBgNVBAYTAlVTMRYw
+FAYDVQQKEw1FbnRydXN0LCBJbmMuMSgwJgYDVQQLEx9TZWUgd3d3LmVudHJ1c3QubmV0L2xlZ2Fs
+LXRlcm1zMTkwNwYDVQQLEzAoYykgMjAxMiBFbnRydXN0LCBJbmMuIC0gZm9yIGF1dGhvcml6ZWQg
+dXNlIG9ubHkxMzAxBgNVBAMTKkVudHJ1c3QgUm9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eSAt
+IEVDMTB2MBAGByqGSM49AgEGBSuBBAAiA2IABIQTydC6bUF74mzQ61VfZgIaJPRbiWlH47jCffHy
+AsWfoPZb1YsGGYZPUxBtByQnoaD41UcZYUx9ypMn6nQM72+WCf5j7HBdNq1nd67JnXxVRDqiY1Ef
+9eNi1KlHBz7MIKNCMEAwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYE
+FLdj5xrdjekIplWDpOBqUEFlEUJJMAoGCCqGSM49BAMDA2cAMGQCMGF52OVCR98crlOZF7ZvHH3h
+vxGU0QOIdeSNiaSKd0bebWHvAvX7td/M/k7//qnmpwIwW5nXhTcGtXsI/esni0qU+eH6p44mCOh8
+kmhtc9hvJqwhAriZtyZBWyVgrtBIGu4G
+-----END CERTIFICATE-----
+
+CFCA EV ROOT
+============
+-----BEGIN CERTIFICATE-----
+MIIFjTCCA3WgAwIBAgIEGErM1jANBgkqhkiG9w0BAQsFADBWMQswCQYDVQQGEwJDTjEwMC4GA1UE
+CgwnQ2hpbmEgRmluYW5jaWFsIENlcnRpZmljYXRpb24gQXV0aG9yaXR5MRUwEwYDVQQDDAxDRkNB
+IEVWIFJPT1QwHhcNMTIwODA4MDMwNzAxWhcNMjkxMjMxMDMwNzAxWjBWMQswCQYDVQQGEwJDTjEw
+MC4GA1UECgwnQ2hpbmEgRmluYW5jaWFsIENlcnRpZmljYXRpb24gQXV0aG9yaXR5MRUwEwYDVQQD
+DAxDRkNBIEVWIFJPT1QwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDXXWvNED8fBVnV
+BU03sQ7smCuOFR36k0sXgiFxEFLXUWRwFsJVaU2OFW2fvwwbwuCjZ9YMrM8irq93VCpLTIpTUnrD
+7i7es3ElweldPe6hL6P3KjzJIx1qqx2hp/Hz7KDVRM8Vz3IvHWOX6Jn5/ZOkVIBMUtRSqy5J35DN
+uF++P96hyk0g1CXohClTt7GIH//62pCfCqktQT+x8Rgp7hZZLDRJGqgG16iI0gNyejLi6mhNbiyW
+ZXvKWfry4t3uMCz7zEasxGPrb382KzRzEpR/38wmnvFyXVBlWY9ps4deMm/DGIq1lY+wejfeWkU7
+xzbh72fROdOXW3NiGUgthxwG+3SYIElz8AXSG7Ggo7cbcNOIabla1jj0Ytwli3i/+Oh+uFzJlU9f
+py25IGvPa931DfSCt/SyZi4QKPaXWnuWFo8BGS1sbn85WAZkgwGDg8NNkt0yxoekN+kWzqotaK8K
+gWU6cMGbrU1tVMoqLUuFG7OA5nBFDWteNfB/O7ic5ARwiRIlk9oKmSJgamNgTnYGmE69g60dWIol
+hdLHZR4tjsbftsbhf4oEIRUpdPA+nJCdDC7xij5aqgwJHsfVPKPtl8MeNPo4+QgO48BdK4PRVmrJ
+tqhUUy54Mmc9gn900PvhtgVguXDbjgv5E1hvcWAQUhC5wUEJ73IfZzF4/5YFjQIDAQABo2MwYTAf
+BgNVHSMEGDAWgBTj/i39KNALtbq2osS/BqoFjJP7LzAPBgNVHRMBAf8EBTADAQH/MA4GA1UdDwEB
+/wQEAwIBBjAdBgNVHQ4EFgQU4/4t/SjQC7W6tqLEvwaqBYyT+y8wDQYJKoZIhvcNAQELBQADggIB
+ACXGumvrh8vegjmWPfBEp2uEcwPenStPuiB/vHiyz5ewG5zz13ku9Ui20vsXiObTej/tUxPQ4i9q
+ecsAIyjmHjdXNYmEwnZPNDatZ8POQQaIxffu2Bq41gt/UP+TqhdLjOztUmCypAbqTuv0axn96/Ua
+4CUqmtzHQTb3yHQFhDmVOdYLO6Qn+gjYXB74BGBSESgoA//vU2YApUo0FmZ8/Qmkrp5nGm9BC2sG
+E5uPhnEFtC+NiWYzKXZUmhH4J/qyP5Hgzg0b8zAarb8iXRvTvyUFTeGSGn+ZnzxEk8rUQElsgIfX
+BDrDMlI1Dlb4pd19xIsNER9Tyx6yF7Zod1rg1MvIB671Oi6ON7fQAUtDKXeMOZePglr4UeWJoBjn
+aH9dCi77o0cOPaYjesYBx4/IXr9tgFa+iiS6M+qf4TIRnvHST4D2G0CvOJ4RUHlzEhLN5mydLIhy
+PDCBBpEi6lmt2hkuIsKNuYyH4Ga8cyNfIWRjgEj1oDwYPZTISEEdQLpe/v5WOaHIz16eGWRGENoX
+kbcFgKyLmZJ956LYBws2J+dIeWCKw9cTXPhyQN9Ky8+ZAAoACxGV2lZFA4gKn2fQ1XmxqI1AbQ3C
+ekD6819kR5LLU7m7Wc5P/dAVUwHY3+vZ5nbv0CO7O6l5s9UCKc2Jo5YPSjXnTkLAdc0Hz+Ys63su
+-----END CERTIFICATE-----
+
+TÜRKTRUST Elektronik Sertifika Hizmet Sağlayıcısı H5
+====================================================
+-----BEGIN CERTIFICATE-----
+MIIEJzCCAw+gAwIBAgIHAI4X/iQggTANBgkqhkiG9w0BAQsFADCBsTELMAkGA1UEBhMCVFIxDzAN
+BgNVBAcMBkFua2FyYTFNMEsGA1UECgxEVMOcUktUUlVTVCBCaWxnaSDEsGxldGnFn2ltIHZlIEJp
+bGnFn2ltIEfDvHZlbmxpxJ9pIEhpem1ldGxlcmkgQS7Fni4xQjBABgNVBAMMOVTDnFJLVFJVU1Qg
+RWxla3Ryb25payBTZXJ0aWZpa2EgSGl6bWV0IFNhxJ9sYXnEsWPEsXPEsSBINTAeFw0xMzA0MzAw
+ODA3MDFaFw0yMzA0MjgwODA3MDFaMIGxMQswCQYDVQQGEwJUUjEPMA0GA1UEBwwGQW5rYXJhMU0w
+SwYDVQQKDERUw5xSS1RSVVNUIEJpbGdpIMSwbGV0acWfaW0gdmUgQmlsacWfaW0gR8O8dmVubGnE
+n2kgSGl6bWV0bGVyaSBBLsWeLjFCMEAGA1UEAww5VMOcUktUUlVTVCBFbGVrdHJvbmlrIFNlcnRp
+ZmlrYSBIaXptZXQgU2HEn2xhecSxY8Sxc8SxIEg1MIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIB
+CgKCAQEApCUZ4WWe60ghUEoI5RHwWrom/4NZzkQqL/7hzmAD/I0Dpe3/a6i6zDQGn1k19uwsu537
+jVJp45wnEFPzpALFp/kRGml1bsMdi9GYjZOHp3GXDSHHmflS0yxjXVW86B8BSLlg/kJK9siArs1m
+ep5Fimh34khon6La8eHBEJ/rPCmBp+EyCNSgBbGM+42WAA4+Jd9ThiI7/PS98wl+d+yG6w8z5UNP
+9FR1bSmZLmZaQ9/LXMrI5Tjxfjs1nQ/0xVqhzPMggCTTV+wVunUlm+hkS7M0hO8EuPbJbKoCPrZV
+4jI3X/xml1/N1p7HIL9Nxqw/dV8c7TKcfGkAaZHjIxhT6QIDAQABo0IwQDAdBgNVHQ4EFgQUVpkH
+HtOsDGlktAxQR95DLL4gwPswDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wDQYJKoZI
+hvcNAQELBQADggEBAJ5FdnsXSDLyOIspve6WSk6BGLFRRyDN0GSxDsnZAdkJzsiZ3GglE9Rc8qPo
+BP5yCccLqh0lVX6Wmle3usURehnmp349hQ71+S4pL+f5bFgWV1Al9j4uPqrtd3GqqpmWRgqujuwq
+URawXs3qZwQcWDD1YIq9pr1N5Za0/EKJAWv2cMhQOQwt1WbZyNKzMrcbGW3LM/nfpeYVhDfwwvJl
+lpKQd/Ct9JDpEXjXk4nAPQu6KfTomZ1yju2dL+6SfaHx/126M2CFYv4HAqGEVka+lgqaE9chTLd8
+B59OTj+RdPsnnRHM3eaxynFNExc5JsUpISuTKWqW+qtB4Uu2NQvAmxU=
+-----END CERTIFICATE-----
+
+Certinomis - Root CA
+====================
+-----BEGIN CERTIFICATE-----
+MIIFkjCCA3qgAwIBAgIBATANBgkqhkiG9w0BAQsFADBaMQswCQYDVQQGEwJGUjETMBEGA1UEChMK
+Q2VydGlub21pczEXMBUGA1UECxMOMDAwMiA0MzM5OTg5MDMxHTAbBgNVBAMTFENlcnRpbm9taXMg
+LSBSb290IENBMB4XDTEzMTAyMTA5MTcxOFoXDTMzMTAyMTA5MTcxOFowWjELMAkGA1UEBhMCRlIx
+EzARBgNVBAoTCkNlcnRpbm9taXMxFzAVBgNVBAsTDjAwMDIgNDMzOTk4OTAzMR0wGwYDVQQDExRD
+ZXJ0aW5vbWlzIC0gUm9vdCBDQTCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBANTMCQos
+P5L2fxSeC5yaah1AMGT9qt8OHgZbn1CF6s2Nq0Nn3rD6foCWnoR4kkjW4znuzuRZWJflLieY6pOo
+d5tK8O90gC3rMB+12ceAnGInkYjwSond3IjmFPnVAy//ldu9n+ws+hQVWZUKxkd8aRi5pwP5ynap
+z8dvtF4F/u7BUrJ1Mofs7SlmO/NKFoL21prbcpjp3vDFTKWrteoB4owuZH9kb/2jJZOLyKIOSY00
+8B/sWEUuNKqEUL3nskoTuLAPrjhdsKkb5nPJWqHZZkCqqU2mNAKthH6yI8H7KsZn9DS2sJVqM09x
+RLWtwHkziOC/7aOgFLScCbAK42C++PhmiM1b8XcF4LVzbsF9Ri6OSyemzTUK/eVNfaoqoynHWmgE
+6OXWk6RiwsXm9E/G+Z8ajYJJGYrKWUM66A0ywfRMEwNvbqY/kXPLynNvEiCL7sCCeN5LLsJJwx3t
+FvYk9CcbXFcx3FXuqB5vbKziRcxXV4p1VxngtViZSTYxPDMBbRZKzbgqg4SGm/lg0h9tkQPTYKbV
+PZrdd5A9NaSfD171UkRpucC63M9933zZxKyGIjK8e2uR73r4F2iw4lNVYC2vPsKD2NkJK/DAZNuH
+i5HMkesE/Xa0lZrmFAYb1TQdvtj/dBxThZngWVJKYe2InmtJiUZ+IFrZ50rlau7SZRFDAgMBAAGj
+YzBhMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBTvkUz1pcMw6C8I
+6tNxIqSSaHh02TAfBgNVHSMEGDAWgBTvkUz1pcMw6C8I6tNxIqSSaHh02TANBgkqhkiG9w0BAQsF
+AAOCAgEAfj1U2iJdGlg+O1QnurrMyOMaauo++RLrVl89UM7g6kgmJs95Vn6RHJk/0KGRHCwPT5iV
+WVO90CLYiF2cN/z7ZMF4jIuaYAnq1fohX9B0ZedQxb8uuQsLrbWwF6YSjNRieOpWauwK0kDDPAUw
+Pk2Ut59KA9N9J0u2/kTO+hkzGm2kQtHdzMjI1xZSg081lLMSVX3l4kLr5JyTCcBMWwerx20RoFAX
+lCOotQqSD7J6wWAsOMwaplv/8gzjqh8c3LigkyfeY+N/IZ865Z764BNqdeuWXGKRlI5nU7aJ+BIJ
+y29SWwNyhlCVCNSNh4YVH5Uk2KRvms6knZtt0rJ2BobGVgjF6wnaNsIbW0G+YSrjcOa4pvi2WsS9
+Iff/ql+hbHY5ZtbqTFXhADObE5hjyW/QASAJN1LnDE8+zbz1X5YnpyACleAu6AdBBR8Vbtaw5Bng
+DwKTACdyxYvRVB9dSsNAl35VpnzBMwQUAR1JIGkLGZOdblgi90AMRgwjY/M50n92Uaf0yKHxDHYi
+I0ZSKS3io0EHVmmY0gUJvGnHWmHNj4FgFU2A3ZDifcRQ8ow7bkrHxuaAKzyBvBGAFhAn1/DNP3nM
+cyrDflOR1m749fPH0FFNjkulW+YZFzvWgQncItzujrnEj1PhZ7szuIgVRs/taTX/dQ1G885x4cVr
+hkIGuUE=
+-----END CERTIFICATE-----
+
+OISTE WISeKey Global Root GB CA
+===============================
+-----BEGIN CERTIFICATE-----
+MIIDtTCCAp2gAwIBAgIQdrEgUnTwhYdGs/gjGvbCwDANBgkqhkiG9w0BAQsFADBtMQswCQYDVQQG
+EwJDSDEQMA4GA1UEChMHV0lTZUtleTEiMCAGA1UECxMZT0lTVEUgRm91bmRhdGlvbiBFbmRvcnNl
+ZDEoMCYGA1UEAxMfT0lTVEUgV0lTZUtleSBHbG9iYWwgUm9vdCBHQiBDQTAeFw0xNDEyMDExNTAw
+MzJaFw0zOTEyMDExNTEwMzFaMG0xCzAJBgNVBAYTAkNIMRAwDgYDVQQKEwdXSVNlS2V5MSIwIAYD
+VQQLExlPSVNURSBGb3VuZGF0aW9uIEVuZG9yc2VkMSgwJgYDVQQDEx9PSVNURSBXSVNlS2V5IEds
+b2JhbCBSb290IEdCIENBMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8AMIIBCgKCAQEA2Be3HEokKtaX
+scriHvt9OO+Y9bI5mE4nuBFde9IllIiCFSZqGzG7qFshISvYD06fWvGxWuR51jIjK+FTzJlFXHtP
+rby/h0oLS5daqPZI7H17Dc0hBt+eFf1Biki3IPShehtX1F1Q/7pn2COZH8g/497/b1t3sWtuuMlk
+9+HKQUYOKXHQuSP8yYFfTvdv37+ErXNku7dCjmn21HYdfp2nuFeKUWdy19SouJVUQHMD9ur06/4o
+Qnc/nSMbsrY9gBQHTC5P99UKFg29ZkM3fiNDecNAhvVMKdqOmq0NpQSHiB6F4+lT1ZvIiwNjeOvg
+GUpuuy9rM2RYk61pv48b74JIxwIDAQABo1EwTzALBgNVHQ8EBAMCAYYwDwYDVR0TAQH/BAUwAwEB
+/zAdBgNVHQ4EFgQUNQ/INmNe4qPs+TtmFc5RUuORmj0wEAYJKwYBBAGCNxUBBAMCAQAwDQYJKoZI
+hvcNAQELBQADggEBAEBM+4eymYGQfp3FsLAmzYh7KzKNbrghcViXfa43FK8+5/ea4n32cZiZBKpD
+dHij40lhPnOMTZTg+XHEthYOU3gf1qKHLwI5gSk8rxWYITD+KJAAjNHhy/peyP34EEY7onhCkRd0
+VQreUGdNZtGn//3ZwLWoo4rOZvUPQ82nK1d7Y0Zqqi5S2PTt4W2tKZB4SLrhI6qjiey1q5bAtEui
+HZeeevJuQHHfaPFlTc58Bd9TZaml8LGXBHAVRgOY1NK/VLSgWH1Sb9pWJmLU2NuJMW8c8CLC02Ic
+Nc1MaRVUGpCY3useX8p3x8uOPUNpnJpY0CQ73xtAln41rYHHTnG6iBM=
+-----END CERTIFICATE-----
+
+SZAFIR ROOT CA2
+===============
+-----BEGIN CERTIFICATE-----
+MIIDcjCCAlqgAwIBAgIUPopdB+xV0jLVt+O2XwHrLdzk1uQwDQYJKoZIhvcNAQELBQAwUTELMAkG
+A1UEBhMCUEwxKDAmBgNVBAoMH0tyYWpvd2EgSXpiYSBSb3psaWN6ZW5pb3dhIFMuQS4xGDAWBgNV
+BAMMD1NaQUZJUiBST09UIENBMjAeFw0xNTEwMTkwNzQzMzBaFw0zNTEwMTkwNzQzMzBaMFExCzAJ
+BgNVBAYTAlBMMSgwJgYDVQQKDB9LcmFqb3dhIEl6YmEgUm96bGljemVuaW93YSBTLkEuMRgwFgYD
+VQQDDA9TWkFGSVIgUk9PVCBDQTIwggEiMA0GCSqGSIb3DQEBAQUAA4IBDwAwggEKAoIBAQC3vD5Q
+qEvNQLXOYeeWyrSh2gwisPq1e3YAd4wLz32ohswmUeQgPYUM1ljj5/QqGJ3a0a4m7utT3PSQ1hNK
+DJA8w/Ta0o4NkjrcsbH/ON7Dui1fgLkCvUqdGw+0w8LBZwPd3BucPbOw3gAeqDRHu5rr/gsUvTaE
+2g0gv/pby6kWIK05YO4vdbbnl5z5Pv1+TW9NL++IDWr63fE9biCloBK0TXC5ztdyO4mTp4CEHCdJ
+ckm1/zuVnsHMyAHs6A6KCpbns6aH5db5BSsNl0BwPLqsdVqc1U2dAgrSS5tmS0YHF2Wtn2yIANwi
+ieDhZNRnvDF5YTy7ykHNXGoAyDw4jlivAgMBAAGjQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0P
+AQH/BAQDAgEGMB0GA1UdDgQWBBQuFqlKGLXLzPVvUPMjX/hd56zwyDANBgkqhkiG9w0BAQsFAAOC
+AQEAtXP4A9xZWx126aMqe5Aosk3AM0+qmrHUuOQn/6mWmc5G4G18TKI4pAZw8PRBEew/R40/cof5
+O/2kbytTAOD/OblqBw7rHRz2onKQy4I9EYKL0rufKq8h5mOGnXkZ7/e7DDWQw4rtTw/1zBLZpD67
+oPwglV9PJi8RI4NOdQcPv5vRtB3pEAT+ymCPoky4rc/hkA/NrgrHXXu3UNLUYfrVFdvXn4dRVOul
+4+vJhaAlIDf7js4MNIThPIGyd05DpYhfhmehPea0XGG2Ptv+tyjFogeutcrKjSoS75ftwjCkySp6
++/NNIxuZMzSgLvWpCz/UXeHPhJ/iGcJfitYgHuNztw==
+-----END CERTIFICATE-----
+
+Certum Trusted Network CA 2
+===========================
+-----BEGIN CERTIFICATE-----
+MIIF0jCCA7qgAwIBAgIQIdbQSk8lD8kyN/yqXhKN6TANBgkqhkiG9w0BAQ0FADCBgDELMAkGA1UE
+BhMCUEwxIjAgBgNVBAoTGVVuaXpldG8gVGVjaG5vbG9naWVzIFMuQS4xJzAlBgNVBAsTHkNlcnR1
+bSBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eTEkMCIGA1UEAxMbQ2VydHVtIFRydXN0ZWQgTmV0d29y
+ayBDQSAyMCIYDzIwMTExMDA2MDgzOTU2WhgPMjA0NjEwMDYwODM5NTZaMIGAMQswCQYDVQQGEwJQ
+TDEiMCAGA1UEChMZVW5pemV0byBUZWNobm9sb2dpZXMgUy5BLjEnMCUGA1UECxMeQ2VydHVtIENl
+cnRpZmljYXRpb24gQXV0aG9yaXR5MSQwIgYDVQQDExtDZXJ0dW0gVHJ1c3RlZCBOZXR3b3JrIENB
+IDIwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQC9+Xj45tWADGSdhhuWZGc/IjoedQF9
+7/tcZ4zJzFxrqZHmuULlIEub2pt7uZld2ZuAS9eEQCsn0+i6MLs+CRqnSZXvK0AkwpfHp+6bJe+o
+CgCXhVqqndwpyeI1B+twTUrWwbNWuKFBOJvR+zF/j+Bf4bE/D44WSWDXBo0Y+aomEKsq09DRZ40b
+Rr5HMNUuctHFY9rnY3lEfktjJImGLjQ/KUxSiyqnwOKRKIm5wFv5HdnnJ63/mgKXwcZQkpsCLL2p
+uTRZCr+ESv/f/rOf69me4Jgj7KZrdxYq28ytOxykh9xGc14ZYmhFV+SQgkK7QtbwYeDBoz1mo130
+GO6IyY0XRSmZMnUCMe4pJshrAua1YkV/NxVaI2iJ1D7eTiew8EAMvE0Xy02isx7QBlrd9pPPV3WZ
+9fqGGmd4s7+W/jTcvedSVuWz5XV710GRBdxdaeOVDUO5/IOWOZV7bIBaTxNyxtd9KXpEulKkKtVB
+Rgkg/iKgtlswjbyJDNXXcPiHUv3a76xRLgezTv7QCdpw75j6VuZt27VXS9zlLCUVyJ4ueE742pye
+hizKV/Ma5ciSixqClnrDvFASadgOWkaLOusm+iPJtrCBvkIApPjW/jAux9JG9uWOdf3yzLnQh1vM
+BhBgu4M1t15n3kfsmUjxpKEV/q2MYo45VU85FrmxY53/twIDAQABo0IwQDAPBgNVHRMBAf8EBTAD
+AQH/MB0GA1UdDgQWBBS2oVQ5AsOgP46KvPrU+Bym0ToO/TAOBgNVHQ8BAf8EBAMCAQYwDQYJKoZI
+hvcNAQENBQADggIBAHGlDs7k6b8/ONWJWsQCYftMxRQXLYtPU2sQF/xlhMcQSZDe28cmk4gmb3DW
+Al45oPePq5a1pRNcgRRtDoGCERuKTsZPpd1iHkTfCVn0W3cLN+mLIMb4Ck4uWBzrM9DPhmDJ2vuA
+L55MYIR4PSFk1vtBHxgP58l1cb29XN40hz5BsA72udY/CROWFC/emh1auVbONTqwX3BNXuMp8SMo
+clm2q8KMZiYcdywmdjWLKKdpoPk79SPdhRB0yZADVpHnr7pH1BKXESLjokmUbOe3lEu6LaTaM4tM
+pkT/WjzGHWTYtTHkpjx6qFcL2+1hGsvxznN3Y6SHb0xRONbkX8eftoEq5IVIeVheO/jbAoJnwTnb
+w3RLPTYe+SmTiGhbqEQZIfCn6IENLOiTNrQ3ssqwGyZ6miUfmpqAnksqP/ujmv5zMnHCnsZy4Ypo
+J/HkD7TETKVhk/iXEAcqMCWpuchxuO9ozC1+9eB+D4Kob7a6bINDd82Kkhehnlt4Fj1F4jNy3eFm
+ypnTycUm/Q1oBEauttmbjL4ZvrHG8hnjXALKLNhvSgfZyTXaQHXyxKcZb55CEJh15pWLYLztxRLX
+is7VmFxWlgPF7ncGNf/P5O4/E2Hu29othfDNrp2yGAlFw5Khchf8R7agCyzxxN5DaAhqXzvwdmP7
+zAYspsbiDrW5viSP
+-----END CERTIFICATE-----
+
+Hellenic Academic and Research Institutions RootCA 2015
+=======================================================
+-----BEGIN CERTIFICATE-----
+MIIGCzCCA/OgAwIBAgIBADANBgkqhkiG9w0BAQsFADCBpjELMAkGA1UEBhMCR1IxDzANBgNVBAcT
+BkF0aGVuczFEMEIGA1UEChM7SGVsbGVuaWMgQWNhZGVtaWMgYW5kIFJlc2VhcmNoIEluc3RpdHV0
+aW9ucyBDZXJ0LiBBdXRob3JpdHkxQDA+BgNVBAMTN0hlbGxlbmljIEFjYWRlbWljIGFuZCBSZXNl
+YXJjaCBJbnN0aXR1dGlvbnMgUm9vdENBIDIwMTUwHhcNMTUwNzA3MTAxMTIxWhcNNDAwNjMwMTAx
+MTIxWjCBpjELMAkGA1UEBhMCR1IxDzANBgNVBAcTBkF0aGVuczFEMEIGA1UEChM7SGVsbGVuaWMg
+QWNhZGVtaWMgYW5kIFJlc2VhcmNoIEluc3RpdHV0aW9ucyBDZXJ0LiBBdXRob3JpdHkxQDA+BgNV
+BAMTN0hlbGxlbmljIEFjYWRlbWljIGFuZCBSZXNlYXJjaCBJbnN0aXR1dGlvbnMgUm9vdENBIDIw
+MTUwggIiMA0GCSqGSIb3DQEBAQUAA4ICDwAwggIKAoICAQDC+Kk/G4n8PDwEXT2QNrCROnk8Zlrv
+bTkBSRq0t89/TSNTt5AA4xMqKKYx8ZEA4yjsriFBzh/a/X0SWwGDD7mwX5nh8hKDgE0GPt+sr+eh
+iGsxr/CL0BgzuNtFajT0AoAkKAoCFZVedioNmToUW/bLy1O8E00BiDeUJRtCvCLYjqOWXjrZMts+
+6PAQZe104S+nfK8nNLspfZu2zwnI5dMK/IhlZXQK3HMcXM1AsRzUtoSMTFDPaI6oWa7CJ06CojXd
+FPQf/7J31Ycvqm59JCfnxssm5uX+Zwdj2EUN3TpZZTlYepKZcj2chF6IIbjV9Cz82XBST3i4vTwr
+i5WY9bPRaM8gFH5MXF/ni+X1NYEZN9cRCLdmvtNKzoNXADrDgfgXy5I2XdGj2HUb4Ysn6npIQf1F
+GQatJ5lOwXBH3bWfgVMS5bGMSF0xQxfjjMZ6Y5ZLKTBOhE5iGV48zpeQpX8B653g+IuJ3SWYPZK2
+fu/Z8VFRfS0myGlZYeCsargqNhEEelC9MoS+L9xy1dcdFkfkR2YgP/SWxa+OAXqlD3pk9Q0Yh9mu
+iNX6hME6wGkoLfINaFGq46V3xqSQDqE3izEjR8EJCOtu93ib14L8hCCZSRm2Ekax+0VVFqmjZayc
+Bw/qa9wfLgZy7IaIEuQt218FL+TwA9MmM+eAws1CoRc0CwIDAQABo0IwQDAPBgNVHRMBAf8EBTAD
+AQH/MA4GA1UdDwEB/wQEAwIBBjAdBgNVHQ4EFgQUcRVnyMjJvXVdctA4GGqd83EkVAswDQYJKoZI
+hvcNAQELBQADggIBAHW7bVRLqhBYRjTyYtcWNl0IXtVsyIe9tC5G8jH4fOpCtZMWVdyhDBKg2mF+
+D1hYc2Ryx+hFjtyp8iY/xnmMsVMIM4GwVhO+5lFc2JsKT0ucVlMC6U/2DWDqTUJV6HwbISHTGzrM
+d/K4kPFox/la/vot9L/J9UUbzjgQKjeKeaO04wlshYaT/4mWJ3iBj2fjRnRUjtkNaeJK9E10A/+y
+d+2VZ5fkscWrv2oj6NSU4kQoYsRL4vDY4ilrGnB+JGGTe08DMiUNRSQrlrRGar9KC/eaj8GsGsVn
+82800vpzY4zvFrCopEYq+OsS7HK07/grfoxSwIuEVPkvPuNVqNxmsdnhX9izjFk0WaSrT2y7Hxjb
+davYy5LNlDhhDgcGH0tGEPEVvo2FXDtKK4F5D7Rpn0lQl033DlZdwJVqwjbDG2jJ9SrcR5q+ss7F
+Jej6A7na+RZukYT1HCjI/CbM1xyQVqdfbzoEvM14iQuODy+jqk+iGxI9FghAD/FGTNeqewjBCvVt
+J94Cj8rDtSvK6evIIVM4pcw72Hc3MKJP2W/R8kCtQXoXxdZKNYm3QdV8hn9VTYNKpXMgwDqvkPGa
+JI7ZjnHKe7iG2rKPmT4dEw0SEe7Uq/DpFXYC5ODfqiAeW2GFZECpkJcNrVPSWh2HagCXZWK0vm9q
+p/UsQu0yrbYhnr68
+-----END CERTIFICATE-----
+
+Hellenic Academic and Research Institutions ECC RootCA 2015
+===========================================================
+-----BEGIN CERTIFICATE-----
+MIICwzCCAkqgAwIBAgIBADAKBggqhkjOPQQDAjCBqjELMAkGA1UEBhMCR1IxDzANBgNVBAcTBkF0
+aGVuczFEMEIGA1UEChM7SGVsbGVuaWMgQWNhZGVtaWMgYW5kIFJlc2VhcmNoIEluc3RpdHV0aW9u
+cyBDZXJ0LiBBdXRob3JpdHkxRDBCBgNVBAMTO0hlbGxlbmljIEFjYWRlbWljIGFuZCBSZXNlYXJj
+aCBJbnN0aXR1dGlvbnMgRUNDIFJvb3RDQSAyMDE1MB4XDTE1MDcwNzEwMzcxMloXDTQwMDYzMDEw
+MzcxMlowgaoxCzAJBgNVBAYTAkdSMQ8wDQYDVQQHEwZBdGhlbnMxRDBCBgNVBAoTO0hlbGxlbmlj
+IEFjYWRlbWljIGFuZCBSZXNlYXJjaCBJbnN0aXR1dGlvbnMgQ2VydC4gQXV0aG9yaXR5MUQwQgYD
+VQQDEztIZWxsZW5pYyBBY2FkZW1pYyBhbmQgUmVzZWFyY2ggSW5zdGl0dXRpb25zIEVDQyBSb290
+Q0EgMjAxNTB2MBAGByqGSM49AgEGBSuBBAAiA2IABJKgQehLgoRc4vgxEZmGZE4JJS+dQS8KrjVP
+dJWyUWRrjWvmP3CV8AVER6ZyOFB2lQJajq4onvktTpnvLEhvTCUp6NFxW98dwXU3tNf6e3pCnGoK
+Vlp8aQuqgAkkbH7BRqNCMEAwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0O
+BBYEFLQiC4KZJAEOnLvkDv2/+5cgk5kqMAoGCCqGSM49BAMCA2cAMGQCMGfOFmI4oqxiRaeplSTA
+GiecMjvAwNW6qef4BENThe5SId6d9SWDPp5YSy/XZxMOIQIwBeF1Ad5o7SofTUwJCA3sS61kFyjn
+dc5FZXIhF8siQQ6ME5g4mlRtm8rifOoCWCKR
+-----END CERTIFICATE-----
+
+Certplus Root CA G1
+===================
+-----BEGIN CERTIFICATE-----
+MIIFazCCA1OgAwIBAgISESBVg+QtPlRWhS2DN7cs3EYRMA0GCSqGSIb3DQEBDQUAMD4xCzAJBgNV
+BAYTAkZSMREwDwYDVQQKDAhDZXJ0cGx1czEcMBoGA1UEAwwTQ2VydHBsdXMgUm9vdCBDQSBHMTAe
+Fw0xNDA1MjYwMDAwMDBaFw0zODAxMTUwMDAwMDBaMD4xCzAJBgNVBAYTAkZSMREwDwYDVQQKDAhD
+ZXJ0cGx1czEcMBoGA1UEAwwTQ2VydHBsdXMgUm9vdCBDQSBHMTCCAiIwDQYJKoZIhvcNAQEBBQAD
+ggIPADCCAgoCggIBANpQh7bauKk+nWT6VjOaVj0W5QOVsjQcmm1iBdTYj+eJZJ+622SLZOZ5KmHN
+r49aiZFluVj8tANfkT8tEBXgfs+8/H9DZ6itXjYj2JizTfNDnjl8KvzsiNWI7nC9hRYt6kuJPKNx
+Qv4c/dMcLRC4hlTqQ7jbxofaqK6AJc96Jh2qkbBIb6613p7Y1/oA/caP0FG7Yn2ksYyy/yARujVj
+BYZHYEMzkPZHogNPlk2dT8Hq6pyi/jQu3rfKG3akt62f6ajUeD94/vI4CTYd0hYCyOwqaK/1jpTv
+LRN6HkJKHRUxrgwEV/xhc/MxVoYxgKDEEW4wduOU8F8ExKyHcomYxZ3MVwia9Az8fXoFOvpHgDm2
+z4QTd28n6v+WZxcIbekN1iNQMLAVdBM+5S//Ds3EC0pd8NgAM0lm66EYfFkuPSi5YXHLtaW6uOrc
+4nBvCGrch2c0798wct3zyT8j/zXhviEpIDCB5BmlIOklynMxdCm+4kLV87ImZsdo/Rmz5yCTmehd
+4F6H50boJZwKKSTUzViGUkAksnsPmBIgJPaQbEfIDbsYIC7Z/fyL8inqh3SV4EJQeIQEQWGw9CEj
+jy3LKCHyamz0GqbFFLQ3ZU+V/YDI+HLlJWvEYLF7bY5KinPOWftwenMGE9nTdDckQQoRb5fc5+R+
+ob0V8rqHDz1oihYHAgMBAAGjYzBhMA4GA1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0G
+A1UdDgQWBBSowcCbkahDFXxdBie0KlHYlwuBsTAfBgNVHSMEGDAWgBSowcCbkahDFXxdBie0KlHY
+lwuBsTANBgkqhkiG9w0BAQ0FAAOCAgEAnFZvAX7RvUz1isbwJh/k4DgYzDLDKTudQSk0YcbX8ACh
+66Ryj5QXvBMsdbRX7gp8CXrc1cqh0DQT+Hern+X+2B50ioUHj3/MeXrKls3N/U/7/SMNkPX0XtPG
+YX2eEeAC7gkE2Qfdpoq3DIMku4NQkv5gdRE+2J2winq14J2by5BSS7CTKtQ+FjPlnsZlFT5kOwQ/
+2wyPX1wdaR+v8+khjPPvl/aatxm2hHSco1S1cE5j2FddUyGbQJJD+tZ3VTNPZNX70Cxqjm0lpu+F
+6ALEUz65noe8zDUa3qHpimOHZR4RKttjd5cUvpoUmRGywO6wT/gUITJDT5+rosuoD6o7BlXGEilX
+CNQ314cnrUlZp5GrRHpejXDbl85IULFzk/bwg2D5zfHhMf1bfHEhYxQUqq/F3pN+aLHsIqKqkHWe
+tUNy6mSjhEv9DKgma3GX7lZjZuhCVPnHHd/Qj1vfyDBviP4NxDMcU6ij/UgQ8uQKTuEVV/xuZDDC
+VRHc6qnNSlSsKWNEz0pAoNZoWRsz+e86i9sgktxChL8Bq4fA1SCC28a5g4VCXA9DO2pJNdWY9BW/
++mGBDAkgGNLQFwzLSABQ6XaCjGTXOqAHVcweMcDvOrRl++O/QmueD6i9a5jc2NvLi6Td11n0bt3+
+qsOR0C5CB8AMTVPNJLFMWx5R9N/pkvo=
+-----END CERTIFICATE-----
+
+Certplus Root CA G2
+===================
+-----BEGIN CERTIFICATE-----
+MIICHDCCAaKgAwIBAgISESDZkc6uo+jF5//pAq/Pc7xVMAoGCCqGSM49BAMDMD4xCzAJBgNVBAYT
+AkZSMREwDwYDVQQKDAhDZXJ0cGx1czEcMBoGA1UEAwwTQ2VydHBsdXMgUm9vdCBDQSBHMjAeFw0x
+NDA1MjYwMDAwMDBaFw0zODAxMTUwMDAwMDBaMD4xCzAJBgNVBAYTAkZSMREwDwYDVQQKDAhDZXJ0
+cGx1czEcMBoGA1UEAwwTQ2VydHBsdXMgUm9vdCBDQSBHMjB2MBAGByqGSM49AgEGBSuBBAAiA2IA
+BM0PW1aC3/BFGtat93nwHcmsltaeTpwftEIRyoa/bfuFo8XlGVzX7qY/aWfYeOKmycTbLXku54uN
+Am8xIk0G42ByRZ0OQneezs/lf4WbGOT8zC5y0xaTTsqZY1yhBSpsBqNjMGEwDgYDVR0PAQH/BAQD
+AgEGMA8GA1UdEwEB/wQFMAMBAf8wHQYDVR0OBBYEFNqDYwJ5jtpMxjwjFNiPwyCrKGBZMB8GA1Ud
+IwQYMBaAFNqDYwJ5jtpMxjwjFNiPwyCrKGBZMAoGCCqGSM49BAMDA2gAMGUCMHD+sAvZ94OX7PNV
+HdTcswYO/jOYnYs5kGuUIe22113WTNchp+e/IQ8rzfcq3IUHnQIxAIYUFuXcsGXCwI4Un78kFmjl
+vPl5adytRSv3tjFzzAalU5ORGpOucGpnutee5WEaXw==
+-----END CERTIFICATE-----
+
+OpenTrust Root CA G1
+====================
+-----BEGIN CERTIFICATE-----
+MIIFbzCCA1egAwIBAgISESCzkFU5fX82bWTCp59rY45nMA0GCSqGSIb3DQEBCwUAMEAxCzAJBgNV
+BAYTAkZSMRIwEAYDVQQKDAlPcGVuVHJ1c3QxHTAbBgNVBAMMFE9wZW5UcnVzdCBSb290IENBIEcx
+MB4XDTE0MDUyNjA4NDU1MFoXDTM4MDExNTAwMDAwMFowQDELMAkGA1UEBhMCRlIxEjAQBgNVBAoM
+CU9wZW5UcnVzdDEdMBsGA1UEAwwUT3BlblRydXN0IFJvb3QgQ0EgRzEwggIiMA0GCSqGSIb3DQEB
+AQUAA4ICDwAwggIKAoICAQD4eUbalsUwXopxAy1wpLuwxQjczeY1wICkES3d5oeuXT2R0odsN7fa
+Yp6bwiTXj/HbpqbfRm9RpnHLPhsxZ2L3EVs0J9V5ToybWL0iEA1cJwzdMOWo010hOHQX/uMftk87
+ay3bfWAfjH1MBcLrARYVmBSO0ZB3Ij/swjm4eTrwSSTilZHcYTSSjFR077F9jAHiOH3BX2pfJLKO
+YheteSCtqx234LSWSE9mQxAGFiQD4eCcjsZGT44ameGPuY4zbGneWK2gDqdkVBFpRGZPTBKnjix9
+xNRbxQA0MMHZmf4yzgeEtE7NCv82TWLxp2NX5Ntqp66/K7nJ5rInieV+mhxNaMbBGN4zK1FGSxyO
+9z0M+Yo0FMT7MzUj8czxKselu7Cizv5Ta01BG2Yospb6p64KTrk5M0ScdMGTHPjgniQlQ/GbI4Kq
+3ywgsNw2TgOzfALU5nsaqocTvz6hdLubDuHAk5/XpGbKuxs74zD0M1mKB3IDVedzagMxbm+WG+Oi
+n6+Sx+31QrclTDsTBM8clq8cIqPQqwWyTBIjUtz9GVsnnB47ev1CI9sjgBPwvFEVVJSmdz7QdFG9
+URQIOTfLHzSpMJ1ShC5VkLG631UAC9hWLbFJSXKAqWLXwPYYEQRVzXR7z2FwefR7LFxckvzluFqr
+TJOVoSfupb7PcSNCupt2LQIDAQABo2MwYTAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB
+/zAdBgNVHQ4EFgQUl0YhVyE12jZVx/PxN3DlCPaTKbYwHwYDVR0jBBgwFoAUl0YhVyE12jZVx/Px
+N3DlCPaTKbYwDQYJKoZIhvcNAQELBQADggIBAB3dAmB84DWn5ph76kTOZ0BP8pNuZtQ5iSas000E
+PLuHIT839HEl2ku6q5aCgZG27dmxpGWX4m9kWaSW7mDKHyP7Rbr/jyTwyqkxf3kfgLMtMrpkZ2Cv
+uVnN35pJ06iCsfmYlIrM4LvgBBuZYLFGZdwIorJGnkSI6pN+VxbSFXJfLkur1J1juONI5f6ELlgK
+n0Md/rcYkoZDSw6cMoYsYPXpSOqV7XAp8dUv/TW0V8/bhUiZucJvbI/NeJWsZCj9VrDDb8O+WVLh
+X4SPgPL0DTatdrOjteFkdjpY3H1PXlZs5VVZV6Xf8YpmMIzUUmI4d7S+KNfKNsSbBfD4Fdvb8e80
+nR14SohWZ25g/4/Ii+GOvUKpMwpZQhISKvqxnUOOBZuZ2mKtVzazHbYNeS2WuOvyDEsMpZTGMKcm
+GS3tTAZQMPH9WD25SxdfGbRqhFS0OE85og2WaMMolP3tLR9Ka0OWLpABEPs4poEL0L9109S5zvE/
+bw4cHjdx5RiHdRk/ULlepEU0rbDK5uUTdg8xFKmOLZTW1YVNcxVPS/KyPu1svf0OnWZzsD2097+o
+4BGkxK51CUpjAEggpsadCwmKtODmzj7HPiY46SvepghJAwSQiumPv+i2tCqjI40cHLI5kqiPAlxA
+OXXUc0ECd97N4EOH1uS6SsNsEn/+KuYj1oxx
+-----END CERTIFICATE-----
+
+OpenTrust Root CA G2
+====================
+-----BEGIN CERTIFICATE-----
+MIIFbzCCA1egAwIBAgISESChaRu/vbm9UpaPI+hIvyYRMA0GCSqGSIb3DQEBDQUAMEAxCzAJBgNV
+BAYTAkZSMRIwEAYDVQQKDAlPcGVuVHJ1c3QxHTAbBgNVBAMMFE9wZW5UcnVzdCBSb290IENBIEcy
+MB4XDTE0MDUyNjAwMDAwMFoXDTM4MDExNTAwMDAwMFowQDELMAkGA1UEBhMCRlIxEjAQBgNVBAoM
+CU9wZW5UcnVzdDEdMBsGA1UEAwwUT3BlblRydXN0IFJvb3QgQ0EgRzIwggIiMA0GCSqGSIb3DQEB
+AQUAA4ICDwAwggIKAoICAQDMtlelM5QQgTJT32F+D3Y5z1zCU3UdSXqWON2ic2rxb95eolq5cSG+
+Ntmh/LzubKh8NBpxGuga2F8ORAbtp+Dz0mEL4DKiltE48MLaARf85KxP6O6JHnSrT78eCbY2albz
+4e6WiWYkBuTNQjpK3eCasMSCRbP+yatcfD7J6xcvDH1urqWPyKwlCm/61UWY0jUJ9gNDlP7ZvyCV
+eYCYitmJNbtRG6Q3ffyZO6v/v6wNj0OxmXsWEH4db0fEFY8ElggGQgT4hNYdvJGmQr5J1WqIP7wt
+UdGejeBSzFfdNTVY27SPJIjki9/ca1TSgSuyzpJLHB9G+h3Ykst2Z7UJmQnlrBcUVXDGPKBWCgOz
+3GIZ38i1MH/1PCZ1Eb3XG7OHngevZXHloM8apwkQHZOJZlvoPGIytbU6bumFAYueQ4xncyhZW+vj
+3CzMpSZyYhK05pyDRPZRpOLAeiRXyg6lPzq1O4vldu5w5pLeFlwoW5cZJ5L+epJUzpM5ChaHvGOz
+9bGTXOBut9Dq+WIyiET7vycotjCVXRIouZW+j1MY5aIYFuJWpLIsEPUdN6b4t/bQWVyJ98LVtZR0
+0dX+G7bw5tYee9I8y6jj9RjzIR9u701oBnstXW5DiabA+aC/gh7PU3+06yzbXfZqfUAkBXKJOAGT
+y3HCOV0GEfZvePg3DTmEJwIDAQABo2MwYTAOBgNVHQ8BAf8EBAMCAQYwDwYDVR0TAQH/BAUwAwEB
+/zAdBgNVHQ4EFgQUajn6QiL35okATV59M4PLuG53hq8wHwYDVR0jBBgwFoAUajn6QiL35okATV59
+M4PLuG53hq8wDQYJKoZIhvcNAQENBQADggIBAJjLq0A85TMCl38th6aP1F5Kr7ge57tx+4BkJamz
+Gj5oXScmp7oq4fBXgwpkTx4idBvpkF/wrM//T2h6OKQQbA2xx6R3gBi2oihEdqc0nXGEL8pZ0keI
+mUEiyTCYYW49qKgFbdEfwFFEVn8nNQLdXpgKQuswv42hm1GqO+qTRmTFAHneIWv2V6CG1wZy7HBG
+S4tz3aAhdT7cHcCP009zHIXZ/n9iyJVvttN7jLpTwm+bREx50B1ws9efAvSyB7DH5fitIw6mVskp
+EndI2S9G/Tvw/HRwkqWOOAgfZDC2t0v7NqwQjqBSM2OdAzVWxWm9xiNaJ5T2pBL4LTM8oValX9YZ
+6e18CL13zSdkzJTaTkZQh+D5wVOAHrut+0dSixv9ovneDiK3PTNZbNTe9ZUGMg1RGUFcPk8G97kr
+gCf2o6p6fAbhQ8MTOWIaNr3gKC6UAuQpLmBVrkA9sHSSXvAgZJY/X0VdiLWK2gKgW0VU3jg9CcCo
+SmVGFvyqv1ROTVu+OEO3KMqLM6oaJbolXCkvW0pujOotnCr2BXbgd5eAiN1nE28daCSLT7d0geX0
+YJ96Vdc+N9oWaz53rK4YcJUIeSkDiv7BO7M/Gg+kO14fWKGVyasvc0rQLW6aWQ9VGHgtPFGml4vm
+u7JwqkwR3v98KzfUetF3NI/n+UL3PIEMS1IK
+-----END CERTIFICATE-----
+
+OpenTrust Root CA G3
+====================
+-----BEGIN CERTIFICATE-----
+MIICITCCAaagAwIBAgISESDm+Ez8JLC+BUCs2oMbNGA/MAoGCCqGSM49BAMDMEAxCzAJBgNVBAYT
+AkZSMRIwEAYDVQQKDAlPcGVuVHJ1c3QxHTAbBgNVBAMMFE9wZW5UcnVzdCBSb290IENBIEczMB4X
+DTE0MDUyNjAwMDAwMFoXDTM4MDExNTAwMDAwMFowQDELMAkGA1UEBhMCRlIxEjAQBgNVBAoMCU9w
+ZW5UcnVzdDEdMBsGA1UEAwwUT3BlblRydXN0IFJvb3QgQ0EgRzMwdjAQBgcqhkjOPQIBBgUrgQQA
+IgNiAARK7liuTcpm3gY6oxH84Bjwbhy6LTAMidnW7ptzg6kjFYwvWYpa3RTqnVkrQ7cG7DK2uu5B
+ta1doYXM6h0UZqNnfkbilPPntlahFVmhTzeXuSIevRHr9LIfXsMUmuXZl5mjYzBhMA4GA1UdDwEB
+/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBRHd8MUi2I5DMlv4VBN0BBY3JWIbTAf
+BgNVHSMEGDAWgBRHd8MUi2I5DMlv4VBN0BBY3JWIbTAKBggqhkjOPQQDAwNpADBmAjEAj6jcnboM
+BBf6Fek9LykBl7+BFjNAk2z8+e2AcG+qj9uEwov1NcoG3GRvaBbhj5G5AjEA2Euly8LQCGzpGPta
+3U1fJAuwACEl74+nBCZx4nxp5V2a+EEfOzmTk51V6s2N8fvB
+-----END CERTIFICATE-----
+
+ISRG Root X1
+============
+-----BEGIN CERTIFICATE-----
+MIIFazCCA1OgAwIBAgIRAIIQz7DSQONZRGPgu2OCiwAwDQYJKoZIhvcNAQELBQAwTzELMAkGA1UE
+BhMCVVMxKTAnBgNVBAoTIEludGVybmV0IFNlY3VyaXR5IFJlc2VhcmNoIEdyb3VwMRUwEwYDVQQD
+EwxJU1JHIFJvb3QgWDEwHhcNMTUwNjA0MTEwNDM4WhcNMzUwNjA0MTEwNDM4WjBPMQswCQYDVQQG
+EwJVUzEpMCcGA1UEChMgSW50ZXJuZXQgU2VjdXJpdHkgUmVzZWFyY2ggR3JvdXAxFTATBgNVBAMT
+DElTUkcgUm9vdCBYMTCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBAK3oJHP0FDfzm54r
+Vygch77ct984kIxuPOZXoHj3dcKi/vVqbvYATyjb3miGbESTtrFj/RQSa78f0uoxmyF+0TM8ukj1
+3Xnfs7j/EvEhmkvBioZxaUpmZmyPfjxwv60pIgbz5MDmgK7iS4+3mX6UA5/TR5d8mUgjU+g4rk8K
+b4Mu0UlXjIB0ttov0DiNewNwIRt18jA8+o+u3dpjq+sWT8KOEUt+zwvo/7V3LvSye0rgTBIlDHCN
+Aymg4VMk7BPZ7hm/ELNKjD+Jo2FR3qyHB5T0Y3HsLuJvW5iB4YlcNHlsdu87kGJ55tukmi8mxdAQ
+4Q7e2RCOFvu396j3x+UCB5iPNgiV5+I3lg02dZ77DnKxHZu8A/lJBdiB3QW0KtZB6awBdpUKD9jf
+1b0SHzUvKBds0pjBqAlkd25HN7rOrFleaJ1/ctaJxQZBKT5ZPt0m9STJEadao0xAH0ahmbWnOlFu
+hjuefXKnEgV4We0+UXgVCwOPjdAvBbI+e0ocS3MFEvzG6uBQE3xDk3SzynTnjh8BCNAw1FtxNrQH
+usEwMFxIt4I7mKZ9YIqioymCzLq9gwQbooMDQaHWBfEbwrbwqHyGO0aoSCqI3Haadr8faqU9GY/r
+OPNk3sgrDQoo//fb4hVC1CLQJ13hef4Y53CIrU7m2Ys6xt0nUW7/vGT1M0NPAgMBAAGjQjBAMA4G
+A1UdDwEB/wQEAwIBBjAPBgNVHRMBAf8EBTADAQH/MB0GA1UdDgQWBBR5tFnme7bl5AFzgAiIyBpY
+9umbbjANBgkqhkiG9w0BAQsFAAOCAgEAVR9YqbyyqFDQDLHYGmkgJykIrGF1XIpu+ILlaS/V9lZL
+ubhzEFnTIZd+50xx+7LSYK05qAvqFyFWhfFQDlnrzuBZ6brJFe+GnY+EgPbk6ZGQ3BebYhtF8GaV
+0nxvwuo77x/Py9auJ/GpsMiu/X1+mvoiBOv/2X/qkSsisRcOj/KKNFtY2PwByVS5uCbMiogziUwt
+hDyC3+6WVwW6LLv3xLfHTjuCvjHIInNzktHCgKQ5ORAzI4JMPJ+GslWYHb4phowim57iaztXOoJw
+TdwJx4nLCgdNbOhdjsnvzqvHu7UrTkXWStAmzOVyyghqpZXjFaH3pO3JLF+l+/+sKAIuvtd7u+Nx
+e5AW0wdeRlN8NwdCjNPElpzVmbUq4JUagEiuTDkHzsxHpFKVK7q4+63SM1N95R1NbdWhscdCb+ZA
+JzVcoyi3B43njTOQ5yOf+1CceWxG1bQVs5ZufpsMljq4Ui0/1lvh+wjChP4kqKOJ2qxq4RgqsahD
+YVvTH9w7jXbyLeiNdd8XM2w9U/t7y0Ff/9yi0GE44Za4rF2LN9d11TPAmRGunUHBcnWEvgJBQl9n
+JEiU0Zsnvgc/ubhPgXRR4Xq37Z0j4r7g1SgEEzwxA57demyPxgcYxn/eR44/KJ4EBs+lVDR3veyJ
+m+kXQ99b21/+jh5Xos1AnX5iItreGCc=
+-----END CERTIFICATE-----
+
+AC RAIZ FNMT-RCM
+================
+-----BEGIN CERTIFICATE-----
+MIIFgzCCA2ugAwIBAgIPXZONMGc2yAYdGsdUhGkHMA0GCSqGSIb3DQEBCwUAMDsxCzAJBgNVBAYT
+AkVTMREwDwYDVQQKDAhGTk1ULVJDTTEZMBcGA1UECwwQQUMgUkFJWiBGTk1ULVJDTTAeFw0wODEw
+MjkxNTU5NTZaFw0zMDAxMDEwMDAwMDBaMDsxCzAJBgNVBAYTAkVTMREwDwYDVQQKDAhGTk1ULVJD
+TTEZMBcGA1UECwwQQUMgUkFJWiBGTk1ULVJDTTCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoC
+ggIBALpxgHpMhm5/yBNtwMZ9HACXjywMI7sQmkCpGreHiPibVmr75nuOi5KOpyVdWRHbNi63URcf
+qQgfBBckWKo3Shjf5TnUV/3XwSyRAZHiItQDwFj8d0fsjz50Q7qsNI1NOHZnjrDIbzAzWHFctPVr
+btQBULgTfmxKo0nRIBnuvMApGGWn3v7v3QqQIecaZ5JCEJhfTzC8PhxFtBDXaEAUwED653cXeuYL
+j2VbPNmaUtu1vZ5Gzz3rkQUCwJaydkxNEJY7kvqcfw+Z374jNUUeAlz+taibmSXaXvMiwzn15Cou
+08YfxGyqxRxqAQVKL9LFwag0Jl1mpdICIfkYtwb1TplvqKtMUejPUBjFd8g5CSxJkjKZqLsXF3mw
+WsXmo8RZZUc1g16p6DULmbvkzSDGm0oGObVo/CK67lWMK07q87Hj/LaZmtVC+nFNCM+HHmpxffnT
+tOmlcYF7wk5HlqX2doWjKI/pgG6BU6VtX7hI+cL5NqYuSf+4lsKMB7ObiFj86xsc3i1w4peSMKGJ
+47xVqCfWS+2QrYv6YyVZLag13cqXM7zlzced0ezvXg5KkAYmY6252TUtB7p2ZSysV4999AeU14EC
+ll2jB0nVetBX+RvnU0Z1qrB5QstocQjpYL05ac70r8NWQMetUqIJ5G+GR4of6ygnXYMgrwTJbFaa
+i0b1AgMBAAGjgYMwgYAwDwYDVR0TAQH/BAUwAwEB/zAOBgNVHQ8BAf8EBAMCAQYwHQYDVR0OBBYE
+FPd9xf3E6Jobd2Sn9R2gzL+HYJptMD4GA1UdIAQ3MDUwMwYEVR0gADArMCkGCCsGAQUFBwIBFh1o
+dHRwOi8vd3d3LmNlcnQuZm5tdC5lcy9kcGNzLzANBgkqhkiG9w0BAQsFAAOCAgEAB5BK3/MjTvDD
+nFFlm5wioooMhfNzKWtN/gHiqQxjAb8EZ6WdmF/9ARP67Jpi6Yb+tmLSbkyU+8B1RXxlDPiyN8+s
+D8+Nb/kZ94/sHvJwnvDKuO+3/3Y3dlv2bojzr2IyIpMNOmqOFGYMLVN0V2Ue1bLdI4E7pWYjJ2cJ
+j+F3qkPNZVEI7VFY/uY5+ctHhKQV8Xa7pO6kO8Rf77IzlhEYt8llvhjho6Tc+hj507wTmzl6NLrT
+Qfv6MooqtyuGC2mDOL7Nii4LcK2NJpLuHvUBKwrZ1pebbuCoGRw6IYsMHkCtA+fdZn71uSANA+iW
++YJF1DngoABd15jmfZ5nc8OaKveri6E6FO80vFIOiZiaBECEHX5FaZNXzuvO+FB8TxxuBEOb+dY7
+Ixjp6o7RTUaN8Tvkasq6+yO3m/qZASlaWFot4/nUbQ4mrcFuNLwy+AwF+mWj2zs3gyLp1txyM/1d
+8iC9djwj2ij3+RvrWWTV3F9yfiD8zYm1kGdNYno/Tq0dwzn+evQoFt9B9kiABdcPUXmsEKvU7ANm
+5mqwujGSQkBqvjrTcuFqN1W8rB2Vt2lh8kORdOag0wokRqEIr9baRRmW1FMdW4R58MD3R++Lj8UG
+rp1MYp3/RgT408m2ECVAdf4WqslKYIYvuu8wd+RU4riEmViAqhOLUTpPSPaLtrM=
+-----END CERTIFICATE-----
+
+Amazon Root CA 1
+================
+-----BEGIN CERTIFICATE-----
+MIIDQTCCAimgAwIBAgITBmyfz5m/jAo54vB4ikPmljZbyjANBgkqhkiG9w0BAQsFADA5MQswCQYD
+VQQGEwJVUzEPMA0GA1UEChMGQW1hem9uMRkwFwYDVQQDExBBbWF6b24gUm9vdCBDQSAxMB4XDTE1
+MDUyNjAwMDAwMFoXDTM4MDExNzAwMDAwMFowOTELMAkGA1UEBhMCVVMxDzANBgNVBAoTBkFtYXpv
+bjEZMBcGA1UEAxMQQW1hem9uIFJvb3QgQ0EgMTCCASIwDQYJKoZIhvcNAQEBBQADggEPADCCAQoC
+ggEBALJ4gHHKeNXjca9HgFB0fW7Y14h29Jlo91ghYPl0hAEvrAIthtOgQ3pOsqTQNroBvo3bSMgH
+FzZM9O6II8c+6zf1tRn4SWiw3te5djgdYZ6k/oI2peVKVuRF4fn9tBb6dNqcmzU5L/qwIFAGbHrQ
+gLKm+a/sRxmPUDgH3KKHOVj4utWp+UhnMJbulHheb4mjUcAwhmahRWa6VOujw5H5SNz/0egwLX0t
+dHA114gk957EWW67c4cX8jJGKLhD+rcdqsq08p8kDi1L93FcXmn/6pUCyziKrlA4b9v7LWIbxcce
+VOF34GfID5yHI9Y/QCB/IIDEgEw+OyQmjgSubJrIqg0CAwEAAaNCMEAwDwYDVR0TAQH/BAUwAwEB
+/zAOBgNVHQ8BAf8EBAMCAYYwHQYDVR0OBBYEFIQYzIU07LwMlJQuCFmcx7IQTgoIMA0GCSqGSIb3
+DQEBCwUAA4IBAQCY8jdaQZChGsV2USggNiMOruYou6r4lK5IpDB/G/wkjUu0yKGX9rbxenDIU5PM
+CCjjmCXPI6T53iHTfIUJrU6adTrCC2qJeHZERxhlbI1Bjjt/msv0tadQ1wUsN+gDS63pYaACbvXy
+8MWy7Vu33PqUXHeeE6V/Uq2V8viTO96LXFvKWlJbYK8U90vvo/ufQJVtMVT8QtPHRh8jrdkPSHCa
+2XV4cdFyQzR1bldZwgJcJmApzyMZFo6IQ6XU5MsI+yMRQ+hDKXJioaldXgjUkK642M4UwtBV8ob2
+xJNDd2ZhwLnoQdeXeGADbkpyrqXRfboQnoZsG4q5WTP468SQvvG5
+-----END CERTIFICATE-----
+
+Amazon Root CA 2
+================
+-----BEGIN CERTIFICATE-----
+MIIFQTCCAymgAwIBAgITBmyf0pY1hp8KD+WGePhbJruKNzANBgkqhkiG9w0BAQwFADA5MQswCQYD
+VQQGEwJVUzEPMA0GA1UEChMGQW1hem9uMRkwFwYDVQQDExBBbWF6b24gUm9vdCBDQSAyMB4XDTE1
+MDUyNjAwMDAwMFoXDTQwMDUyNjAwMDAwMFowOTELMAkGA1UEBhMCVVMxDzANBgNVBAoTBkFtYXpv
+bjEZMBcGA1UEAxMQQW1hem9uIFJvb3QgQ0EgMjCCAiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoC
+ggIBAK2Wny2cSkxKgXlRmeyKy2tgURO8TW0G/LAIjd0ZEGrHJgw12MBvIITplLGbhQPDW9tK6Mj4
+kHbZW0/jTOgGNk3Mmqw9DJArktQGGWCsN0R5hYGCrVo34A3MnaZMUnbqQ523BNFQ9lXg1dKmSYXp
+N+nKfq5clU1Imj+uIFptiJXZNLhSGkOQsL9sBbm2eLfq0OQ6PBJTYv9K8nu+NQWpEjTj82R0Yiw9
+AElaKP4yRLuH3WUnAnE72kr3H9rN9yFVkE8P7K6C4Z9r2UXTu/Bfh+08LDmG2j/e7HJV63mjrdvd
+fLC6HM783k81ds8P+HgfajZRRidhW+mez/CiVX18JYpvL7TFz4QuK/0NURBs+18bvBt+xa47mAEx
+kv8LV/SasrlX6avvDXbR8O70zoan4G7ptGmh32n2M8ZpLpcTnqWHsFcQgTfJU7O7f/aS0ZzQGPSS
+btqDT6ZjmUyl+17vIWR6IF9sZIUVyzfpYgwLKhbcAS4y2j5L9Z469hdAlO+ekQiG+r5jqFoz7Mt0
+Q5X5bGlSNscpb/xVA1wf+5+9R+vnSUeVC06JIglJ4PVhHvG/LopyboBZ/1c6+XUyo05f7O0oYtlN
+c/LMgRdg7c3r3NunysV+Ar3yVAhU/bQtCSwXVEqY0VThUWcI0u1ufm8/0i2BWSlmy5A5lREedCf+
+3euvAgMBAAGjQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgGGMB0GA1UdDgQWBBSw
+DPBMMPQFWAJI/TPlUq9LhONmUjANBgkqhkiG9w0BAQwFAAOCAgEAqqiAjw54o+Ci1M3m9Zh6O+oA
+A7CXDpO8Wqj2LIxyh6mx/H9z/WNxeKWHWc8w4Q0QshNabYL1auaAn6AFC2jkR2vHat+2/XcycuUY
++gn0oJMsXdKMdYV2ZZAMA3m3MSNjrXiDCYZohMr/+c8mmpJ5581LxedhpxfL86kSk5Nrp+gvU5LE
+YFiwzAJRGFuFjWJZY7attN6a+yb3ACfAXVU3dJnJUH/jWS5E4ywl7uxMMne0nxrpS10gxdr9HIcW
+xkPo1LsmmkVwXqkLN1PiRnsn/eBG8om3zEK2yygmbtmlyTrIQRNg91CMFa6ybRoVGld45pIq2WWQ
+gj9sAq+uEjonljYE1x2igGOpm/HlurR8FLBOybEfdF849lHqm/osohHUqS0nGkWxr7JOcQ3AWEbW
+aQbLU8uz/mtBzUF+fUwPfHJ5elnNXkoOrJupmHN5fLT0zLm4BwyydFy4x2+IoZCn9Kr5v2c69BoV
+Yh63n749sSmvZ6ES8lgQGVMDMBu4Gon2nL2XA46jCfMdiyHxtN/kHNGfZQIG6lzWE7OE76KlXIx3
+KadowGuuQNKotOrN8I1LOJwZmhsoVLiJkO/KdYE+HvJkJMcYr07/R54H9jVlpNMKVv/1F2Rs76gi
+JUmTtt8AF9pYfl3uxRuw0dFfIRDH+fO6AgonB8Xx1sfT4PsJYGw=
+-----END CERTIFICATE-----
+
+Amazon Root CA 3
+================
+-----BEGIN CERTIFICATE-----
+MIIBtjCCAVugAwIBAgITBmyf1XSXNmY/Owua2eiedgPySjAKBggqhkjOPQQDAjA5MQswCQYDVQQG
+EwJVUzEPMA0GA1UEChMGQW1hem9uMRkwFwYDVQQDExBBbWF6b24gUm9vdCBDQSAzMB4XDTE1MDUy
+NjAwMDAwMFoXDTQwMDUyNjAwMDAwMFowOTELMAkGA1UEBhMCVVMxDzANBgNVBAoTBkFtYXpvbjEZ
+MBcGA1UEAxMQQW1hem9uIFJvb3QgQ0EgMzBZMBMGByqGSM49AgEGCCqGSM49AwEHA0IABCmXp8ZB
+f8ANm+gBG1bG8lKlui2yEujSLtf6ycXYqm0fc4E7O5hrOXwzpcVOho6AF2hiRVd9RFgdszflZwjr
+Zt6jQjBAMA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgGGMB0GA1UdDgQWBBSrttvXBp43
+rDCGB5Fwx5zEGbF4wDAKBggqhkjOPQQDAgNJADBGAiEA4IWSoxe3jfkrBqWTrBqYaGFy+uGh0Psc
+eGCmQ5nFuMQCIQCcAu/xlJyzlvnrxir4tiz+OpAUFteMYyRIHN8wfdVoOw==
+-----END CERTIFICATE-----
+
+Amazon Root CA 4
+================
+-----BEGIN CERTIFICATE-----
+MIIB8jCCAXigAwIBAgITBmyf18G7EEwpQ+Vxe3ssyBrBDjAKBggqhkjOPQQDAzA5MQswCQYDVQQG
+EwJVUzEPMA0GA1UEChMGQW1hem9uMRkwFwYDVQQDExBBbWF6b24gUm9vdCBDQSA0MB4XDTE1MDUy
+NjAwMDAwMFoXDTQwMDUyNjAwMDAwMFowOTELMAkGA1UEBhMCVVMxDzANBgNVBAoTBkFtYXpvbjEZ
+MBcGA1UEAxMQQW1hem9uIFJvb3QgQ0EgNDB2MBAGByqGSM49AgEGBSuBBAAiA2IABNKrijdPo1MN
+/sGKe0uoe0ZLY7Bi9i0b2whxIdIA6GO9mif78DluXeo9pcmBqqNbIJhFXRbb/egQbeOc4OO9X4Ri
+83BkM6DLJC9wuoihKqB1+IGuYgbEgds5bimwHvouXKNCMEAwDwYDVR0TAQH/BAUwAwEB/zAOBgNV
+HQ8BAf8EBAMCAYYwHQYDVR0OBBYEFNPsxzplbszh2naaVvuc84ZtV+WBMAoGCCqGSM49BAMDA2gA
+MGUCMDqLIfG9fhGt0O9Yli/W651+kI0rz2ZVwyzjKKlwCkcO8DdZEv8tmZQoTipPNU0zWgIxAOp1
+AE47xDqUEpHJWEadIRNyp4iciuRMStuW1KyLa2tJElMzrdfkviT8tQp21KW8EA==
+-----END CERTIFICATE-----
+
+LuxTrust Global Root 2
+======================
+-----BEGIN CERTIFICATE-----
+MIIFwzCCA6ugAwIBAgIUCn6m30tEntpqJIWe5rgV0xZ/u7EwDQYJKoZIhvcNAQELBQAwRjELMAkG
+A1UEBhMCTFUxFjAUBgNVBAoMDUx1eFRydXN0IFMuQS4xHzAdBgNVBAMMFkx1eFRydXN0IEdsb2Jh
+bCBSb290IDIwHhcNMTUwMzA1MTMyMTU3WhcNMzUwMzA1MTMyMTU3WjBGMQswCQYDVQQGEwJMVTEW
+MBQGA1UECgwNTHV4VHJ1c3QgUy5BLjEfMB0GA1UEAwwWTHV4VHJ1c3QgR2xvYmFsIFJvb3QgMjCC
+AiIwDQYJKoZIhvcNAQEBBQADggIPADCCAgoCggIBANeFl78RmOnwYoNMPIf5U2o3C/IPPIfOb9wm
+Kb3FibrJgz337spbxm1Jc7TJRqMbNBM/wYlFV/TZsfs2ZUv7COJIcRHIbjuend+JZTemhfY7RBi2
+xjcwYkSSl2l9QjAk5A0MiWtj3sXh306pFGxT4GHO9hcvHTy95iJMHZP1EMShduxq3sVs35a0VkBC
+wGKSMKEtFZSg0iAGCW5qbeXrt77U8PEVfIvmTroTzEsnXpk8F12PgX8zPU/TPxvsXD/wPEx1bvKm
+1Z3aLQdjAsZy6ZS8TEmVT4hSyNvoaYL4zDRbIvCGp4m9SAptZoFtyMhk+wHh9OHe2Z7d21vUKpkm
+FRseTJIpgp7VkoGSQXAZ96Tlk0u8d2cx3Rz9MXANF5kM+Qw5GSoXtTBxVdUPrljhPS80m8+f9niF
+wpN6cj5mj5wWEWCPnolvZ77gR1o7DJpni89Gxq44o/KnvObWhWszJHAiS8sIm7vI+AIpHb4gDEa/
+a4ebsypmQjVGbKq6rfmYe+lQVRQxv7HaLe2ArWgk+2mr2HETMOZns4dA/Yl+8kPREd8vZS9kzl8U
+ubG/Mb2HeFpZZYiq/FkySIbWTLkpS5XTdvN3JW1CHDiDTf2jX5t/Lax5Gw5CMZdjpPuKadUiDTSQ
+MC6otOBttpSsvItO13D8xTiOZCXhTTmQzsmHhFhxAgMBAAGjgagwgaUwDwYDVR0TAQH/BAUwAwEB
+/zBCBgNVHSAEOzA5MDcGByuBKwEBAQowLDAqBggrBgEFBQcCARYeaHR0cHM6Ly9yZXBvc2l0b3J5
+Lmx1eHRydXN0Lmx1MA4GA1UdDwEB/wQEAwIBBjAfBgNVHSMEGDAWgBT/GCh2+UgFLKGu8SsbK7JT
++Et8szAdBgNVHQ4EFgQU/xgodvlIBSyhrvErGyuyU/hLfLMwDQYJKoZIhvcNAQELBQADggIBAGoZ
+FO1uecEsh9QNcH7X9njJCwROxLHOk3D+sFTAMs2ZMGQXvw/l4jP9BzZAcg4atmpZ1gDlaCDdLnIN
+H2pkMSCEfUmmWjfrRcmF9dTHF5kH5ptV5AzoqbTOjFu1EVzPig4N1qx3gf4ynCSecs5U89BvolbW
+7MM3LGVYvlcAGvI1+ut7MV3CwRI9loGIlonBWVx65n9wNOeD4rHh4bhY79SV5GCc8JaXcozrhAIu
+ZY+kt9J/Z93I055cqqmkoCUUBpvsT34tC38ddfEz2O3OuHVtPlu5mB0xDVbYQw8wkbIEa91WvpWA
+VWe+2M2D2RjuLg+GLZKecBPs3lHJQ3gCpU3I+V/EkVhGFndadKpAvAefMLmx9xIX3eP/JEAdemrR
+TxgKqpAd60Ae36EeRJIQmvKN4dFLRp7oRUKX6kWZ8+xm1QL68qZKJKrezrnK+T+Tb/mjuuqlPpmt
+/f97mfVl7vBZKGfXkJWkE4SphMHozs51k2MavDzq1WQfLSoSOcbDWjLtR5EWDrw4wVDej8oqkDQc
+7kGUnF4ZLvhFSZl0kbAEb+MEWrGrKqv+x9CWttrhSmQGbmBNvUJO/3jaJMobtNeWOWyu8Q6qp31I
+iyBMz2TWuJdGsE7RKlY6oJO9r4Ak4Ap+58rVyuiFVdw2KuGUaJPHZnJED4AhMmwlxyOAgwrr
+-----END CERTIFICATE-----
+
+TUBITAK Kamu SM SSL Kok Sertifikasi - Surum 1
+=============================================
+-----BEGIN CERTIFICATE-----
+MIIEYzCCA0ugAwIBAgIBATANBgkqhkiG9w0BAQsFADCB0jELMAkGA1UEBhMCVFIxGDAWBgNVBAcT
+D0dlYnplIC0gS29jYWVsaTFCMEAGA1UEChM5VHVya2l5ZSBCaWxpbXNlbCB2ZSBUZWtub2xvamlr
+IEFyYXN0aXJtYSBLdXJ1bXUgLSBUVUJJVEFLMS0wKwYDVQQLEyRLYW11IFNlcnRpZmlrYXN5b24g
+TWVya2V6aSAtIEthbXUgU00xNjA0BgNVBAMTLVRVQklUQUsgS2FtdSBTTSBTU0wgS29rIFNlcnRp
+ZmlrYXNpIC0gU3VydW0gMTAeFw0xMzExMjUwODI1NTVaFw00MzEwMjUwODI1NTVaMIHSMQswCQYD
+VQQGEwJUUjEYMBYGA1UEBxMPR2ViemUgLSBLb2NhZWxpMUIwQAYDVQQKEzlUdXJraXllIEJpbGlt
+c2VsIHZlIFRla25vbG9qaWsgQXJhc3Rpcm1hIEt1cnVtdSAtIFRVQklUQUsxLTArBgNVBAsTJEth
+bXUgU2VydGlmaWthc3lvbiBNZXJrZXppIC0gS2FtdSBTTTE2MDQGA1UEAxMtVFVCSVRBSyBLYW11
+IFNNIFNTTCBLb2sgU2VydGlmaWthc2kgLSBTdXJ1bSAxMIIBIjANBgkqhkiG9w0BAQEFAAOCAQ8A
+MIIBCgKCAQEAr3UwM6q7a9OZLBI3hNmNe5eA027n/5tQlT6QlVZC1xl8JoSNkvoBHToP4mQ4t4y8
+6Ij5iySrLqP1N+RAjhgleYN1Hzv/bKjFxlb4tO2KRKOrbEz8HdDc72i9z+SqzvBV96I01INrN3wc
+wv61A+xXzry0tcXtAA9TNypN9E8Mg/uGz8v+jE69h/mniyFXnHrfA2eJLJ2XYacQuFWQfw4tJzh0
+3+f92k4S400VIgLI4OD8D62K18lUUMw7D8oWgITQUVbDjlZ/iSIzL+aFCr2lqBs23tPcLG07xxO9
+WSMs5uWk99gL7eqQQESolbuT1dCANLZGeA4fAJNG4e7p+exPFwIDAQABo0IwQDAdBgNVHQ4EFgQU
+ZT/HiobGPN08VFw1+DrtUgxHV8gwDgYDVR0PAQH/BAQDAgEGMA8GA1UdEwEB/wQFMAMBAf8wDQYJ
+KoZIhvcNAQELBQADggEBACo/4fEyjq7hmFxLXs9rHmoJ0iKpEsdeV31zVmSAhHqT5Am5EM2fKifh
+AHe+SMg1qIGf5LgsyX8OsNJLN13qudULXjS99HMpw+0mFZx+CFOKWI3QSyjfwbPfIPP54+M638yc
+lNhOT8NrF7f3cuitZjO1JVOr4PhMqZ398g26rrnZqsZr+ZO7rqu4lzwDGrpDxpa5RXI4s6ehlj2R
+e37AIVNMh+3yC1SVUZPVIqUNivGTDj5UDrDYyU7c8jEyVupk+eq1nRZmQnLzf9OxMUP8pI4X8W0j
+q5Rm+K37DwhuJi1/FwcJsoz7UMCflo3Ptv0AnVoUmr8CRPXBwp8iXqIPoeM=
+-----END CERTIFICATE-----
+
+GDCA TrustAUTH R5 ROOT
+======================
+-----BEGIN CERTIFICATE-----
+MIIFiDCCA3CgAwIBAgIIfQmX/vBH6nowDQYJKoZIhvcNAQELBQAwYjELMAkGA1UEBhMCQ04xMjAw
+BgNVBAoMKUdVQU5HIERPTkcgQ0VSVElGSUNBVEUgQVVUSE9SSVRZIENPLixMVEQuMR8wHQYDVQQD
+DBZHRENBIFRydXN0QVVUSCBSNSBST09UMB4XDTE0MTEyNjA1MTMxNVoXDTQwMTIzMTE1NTk1OVow
+YjELMAkGA1UEBhMCQ04xMjAwBgNVBAoMKUdVQU5HIERPTkcgQ0VSVElGSUNBVEUgQVVUSE9SSVRZ
+IENPLixMVEQuMR8wHQYDVQQDDBZHRENBIFRydXN0QVVUSCBSNSBST09UMIICIjANBgkqhkiG9w0B
+AQEFAAOCAg8AMIICCgKCAgEA2aMW8Mh0dHeb7zMNOwZ+Vfy1YI92hhJCfVZmPoiC7XJjDp6L3TQs
+AlFRwxn9WVSEyfFrs0yw6ehGXTjGoqcuEVe6ghWinI9tsJlKCvLriXBjTnnEt1u9ol2x8kECK62p
+OqPseQrsXzrj/e+APK00mxqriCZ7VqKChh/rNYmDf1+uKU49tm7srsHwJ5uu4/Ts765/94Y9cnrr
+pftZTqfrlYwiOXnhLQiPzLyRuEH3FMEjqcOtmkVEs7LXLM3GKeJQEK5cy4KOFxg2fZfmiJqwTTQJ
+9Cy5WmYqsBebnh52nUpmMUHfP/vFBu8btn4aRjb3ZGM74zkYI+dndRTVdVeSN72+ahsmUPI2JgaQ
+xXABZG12ZuGR224HwGGALrIuL4xwp9E7PLOR5G62xDtw8mySlwnNR30YwPO7ng/Wi64HtloPzgsM
+R6flPri9fcebNaBhlzpBdRfMK5Z3KpIhHtmVdiBnaM8Nvd/WHwlqmuLMc3GkL30SgLdTMEZeS1SZ
+D2fJpcjyIMGC7J0R38IC+xo70e0gmu9lZJIQDSri3nDxGGeCjGHeuLzRL5z7D9Ar7Rt2ueQ5Vfj4
+oR24qoAATILnsn8JuLwwoC8N9VKejveSswoAHQBUlwbgsQfZxw9cZX08bVlX5O2ljelAU58VS6Bx
+9hoh49pwBiFYFIeFd3mqgnkCAwEAAaNCMEAwHQYDVR0OBBYEFOLJQJ9NzuiaoXzPDj9lxSmIahlR
+MA8GA1UdEwEB/wQFMAMBAf8wDgYDVR0PAQH/BAQDAgGGMA0GCSqGSIb3DQEBCwUAA4ICAQDRSVfg
+p8xoWLoBDysZzY2wYUWsEe1jUGn4H3++Fo/9nesLqjJHdtJnJO29fDMylyrHBYZmDRd9FBUb1Ov9
+H5r2XpdptxolpAqzkT9fNqyL7FeoPueBihhXOYV0GkLH6VsTX4/5COmSdI31R9KrO9b7eGZONn35
+6ZLpBN79SWP8bfsUcZNnL0dKt7n/HipzcEYwv1ryL3ml4Y0M2fmyYzeMN2WFcGpcWwlyua1jPLHd
++PwyvzeG5LuOmCd+uh8W4XAR8gPfJWIyJyYYMoSf/wA6E7qaTfRPuBRwIrHKK5DOKcFw9C+df/KQ
+HtZa37dG/OaG+svgIHZ6uqbL9XzeYqWxi+7egmaKTjowHz+Ay60nugxe19CxVsp3cbK1daFQqUBD
+F8Io2c9Si1vIY9RCPqAzekYu9wogRlR+ak8x8YF+QnQ4ZXMn7sZ8uI7XpTrXmKGcjBBV09tL7ECQ
+8s1uV9JiDnxXk7Gnbc2dg7sq5+W2O3FYrf3RRbxake5TFW/TRQl1brqQXR4EzzffHqhmsYzmIGrv
+/EhOdJhCrylvLmrH+33RZjEizIYAfmaDDEL0vTSSwxrqT8p+ck0LcIymSLumoRT2+1hEmRSuqguT
+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-----
+MIIF3TCCA8WgAwIBAgIIeyyb0xaAMpkwDQYJKoZIhvcNAQELBQAwfDELMAkGA1UEBhMCVVMxDjAM
+BgNVBAgMBVRleGFzMRAwDgYDVQQHDAdIb3VzdG9uMRgwFgYDVQQKDA9TU0wgQ29ycG9yYXRpb24x
+MTAvBgNVBAMMKFNTTC5jb20gUm9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eSBSU0EwHhcNMTYw
+MjEyMTczOTM5WhcNNDEwMjEyMTczOTM5WjB8MQswCQYDVQQGEwJVUzEOMAwGA1UECAwFVGV4YXMx
+EDAOBgNVBAcMB0hvdXN0b24xGDAWBgNVBAoMD1NTTCBDb3Jwb3JhdGlvbjExMC8GA1UEAwwoU1NM
+LmNvbSBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5IFJTQTCCAiIwDQYJKoZIhvcNAQEBBQAD
+ggIPADCCAgoCggIBAPkP3aMrfcvQKv7sZ4Wm5y4bunfh4/WvpOz6Sl2RxFdHaxh3a3by/ZPkPQ/C
+Fp4LZsNWlJ4Xg4XOVu/yFv0AYvUiCVToZRdOQbngT0aXqhvIuG5iXmmxX9sqAn78bMrzQdjt0Oj8
+P2FI7bADFB0QDksZ4LtO7IZl/zbzXmcCC52GVWH9ejjt/uIZALdvoVBidXQ8oPrIJZK0bnoix/ge
+oeOy3ZExqysdBP+lSgQ36YWkMyv94tZVNHwZpEpox7Ko07fKoZOI68GXvIz5HdkihCR0xwQ9aqkp
+k8zruFvh/l8lqjRYyMEjVJ0bmBHDOJx+PYZspQ9AhnwC9FwCTyjLrnGfDzrIM/4RJTXq/LrFYD3Z
+fBjVsqnTdXgDciLKOsMf7yzlLqn6niy2UUb9rwPW6mBo6oUWNmuF6R7As93EJNyAKoFBbZQ+yODJ
+gUEAnl6/f8UImKIYLEJAs/lvOCdLToD0PYFH4Ih86hzOtXVcUS4cK38acijnALXRdMbX5J+tB5O2
+UzU1/Dfkw/ZdFr4hc96SCvigY2q8lpJqPvi8ZVWb3vUNiSYE/CUapiVpy8JtynziWV+XrOvvLsi8
+1xtZPCvM8hnIk2snYxnP/Okm+Mpxm3+T/jRnhE6Z6/yzeAkzcLpmpnbtG3PrGqUNxCITIJRWCk4s
+bE6x/c+cCbqiM+2HAgMBAAGjYzBhMB0GA1UdDgQWBBTdBAkHovV6fVJTEpKV7jiAJQ2mWTAPBgNV
+HRMBAf8EBTADAQH/MB8GA1UdIwQYMBaAFN0ECQei9Xp9UlMSkpXuOIAlDaZZMA4GA1UdDwEB/wQE
+AwIBhjANBgkqhkiG9w0BAQsFAAOCAgEAIBgRlCn7Jp0cHh5wYfGVcpNxJK1ok1iOMq8bs3AD/CUr
+dIWQPXhq9LmLpZc7tRiRux6n+UBbkflVma8eEdBcHadm47GUBwwyOabqG7B52B2ccETjit3E+ZUf
+ijhDPwGFpUenPUayvOUiaPd7nNgsPgohyC0zrL/FgZkxdMF1ccW+sfAjRfSda/wZY52jvATGGAsl
+u1OJD7OAUN5F7kR/q5R4ZJjT9ijdh9hwZXT7DrkT66cPYakylszeu+1jTBi7qUD3oFRuIIhxdRjq
+erQ0cuAjJ3dctpDqhiVAq+8zD8ufgr6iIPv2tS0a5sKFsXQP+8hlAqRSAUfdSSLBv9jra6x+3uxj
+MxW3IwiPxg+NQVrdjsW5j+VFP3jbutIbQLH+cU0/4IGiul607BXgk90IH37hVZkLId6Tngr75qNJ
+vTYw/ud3sqB1l7UtgYgXZSD32pAAn8lSzDLKNXz1PQ/YK9f1JmzJBjSWFupwWRoyeXkLtoh/D1JI
+Pb9s2KJELtFOt3JY04kTlf5Eq/jXixtunLwsoFvVagCvXzfh1foQC5ichucmj87w7G6KVwuA406y
+wKBjYZC6VWg3dGq2ktufoYYitmUnDuy2n0Jg5GfCtdpBC8TTi2EbvPofkSvXRAdeuims2cXp71NI
+WuuA8ShYIc2wBlX7Jz9TkHCpBB5XJ7k=
+-----END CERTIFICATE-----
+
+SSL.com Root Certification Authority ECC
+========================================
+-----BEGIN CERTIFICATE-----
+MIICjTCCAhSgAwIBAgIIdebfy8FoW6gwCgYIKoZIzj0EAwIwfDELMAkGA1UEBhMCVVMxDjAMBgNV
+BAgMBVRleGFzMRAwDgYDVQQHDAdIb3VzdG9uMRgwFgYDVQQKDA9TU0wgQ29ycG9yYXRpb24xMTAv
+BgNVBAMMKFNTTC5jb20gUm9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eSBFQ0MwHhcNMTYwMjEy
+MTgxNDAzWhcNNDEwMjEyMTgxNDAzWjB8MQswCQYDVQQGEwJVUzEOMAwGA1UECAwFVGV4YXMxEDAO
+BgNVBAcMB0hvdXN0b24xGDAWBgNVBAoMD1NTTCBDb3Jwb3JhdGlvbjExMC8GA1UEAwwoU1NMLmNv
+bSBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5IEVDQzB2MBAGByqGSM49AgEGBSuBBAAiA2IA
+BEVuqVDEpiM2nl8ojRfLliJkP9x6jh3MCLOicSS6jkm5BBtHllirLZXI7Z4INcgn64mMU1jrYor+
+8FsPazFSY0E7ic3s7LaNGdM0B9y7xgZ/wkWV7Mt/qCPgCemB+vNH06NjMGEwHQYDVR0OBBYEFILR
+hXMw5zUE044CkvvlpNHEIejNMA8GA1UdEwEB/wQFMAMBAf8wHwYDVR0jBBgwFoAUgtGFczDnNQTT
+jgKS++Wk0cQh6M0wDgYDVR0PAQH/BAQDAgGGMAoGCCqGSM49BAMCA2cAMGQCMG/n61kRpGDPYbCW
+e+0F+S8Tkdzt5fxQaxFGRrMcIQBiu77D5+jNB5n5DQtdcj7EqgIwH7y6C+IwJPt8bYBVCpk+gA0z
+5Wajs6O7pdWLjwkspl1+4vAHCGht0nxpbl/f5Wpl
+-----END CERTIFICATE-----
+
+SSL.com EV Root Certification Authority RSA R2
+==============================================
+-----BEGIN CERTIFICATE-----
+MIIF6zCCA9OgAwIBAgIIVrYpzTS8ePYwDQYJKoZIhvcNAQELBQAwgYIxCzAJBgNVBAYTAlVTMQ4w
+DAYDVQQIDAVUZXhhczEQMA4GA1UEBwwHSG91c3RvbjEYMBYGA1UECgwPU1NMIENvcnBvcmF0aW9u
+MTcwNQYDVQQDDC5TU0wuY29tIEVWIFJvb3QgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkgUlNBIFIy
+MB4XDTE3MDUzMTE4MTQzN1oXDTQyMDUzMDE4MTQzN1owgYIxCzAJBgNVBAYTAlVTMQ4wDAYDVQQI
+DAVUZXhhczEQMA4GA1UEBwwHSG91c3RvbjEYMBYGA1UECgwPU1NMIENvcnBvcmF0aW9uMTcwNQYD
+VQQDDC5TU0wuY29tIEVWIFJvb3QgQ2VydGlmaWNhdGlvbiBBdXRob3JpdHkgUlNBIFIyMIICIjAN
+BgkqhkiG9w0BAQEFAAOCAg8AMIICCgKCAgEAjzZlQOHWTcDXtOlG2mvqM0fNTPl9fb69LT3w23jh
+hqXZuglXaO1XPqDQCEGD5yhBJB/jchXQARr7XnAjssufOePPxU7Gkm0mxnu7s9onnQqG6YE3Bf7w
+cXHswxzpY6IXFJ3vG2fThVUCAtZJycxa4bH3bzKfydQ7iEGonL3Lq9ttewkfokxykNorCPzPPFTO
+Zw+oz12WGQvE43LrrdF9HSfvkusQv1vrO6/PgN3B0pYEW3p+pKk8OHakYo6gOV7qd89dAFmPZiw+
+B6KjBSYRaZfqhbcPlgtLyEDhULouisv3D5oi53+aNxPN8k0TayHRwMwi8qFG9kRpnMphNQcAb9Zh
+CBHqurj26bNg5U257J8UZslXWNvNh2n4ioYSA0e/ZhN2rHd9NCSFg83XqpyQGp8hLH94t2S42Oim
+9HizVcuE0jLEeK6jj2HdzghTreyI/BXkmg3mnxp3zkyPuBQVPWKchjgGAGYS5Fl2WlPAApiiECto
+RHuOec4zSnaqW4EWG7WK2NAAe15itAnWhmMOpgWVSbooi4iTsjQc2KRVbrcc0N6ZVTsj9CLg+Slm
+JuwgUHfbSguPvuUCYHBBXtSuUDkiFCbLsjtzdFVHB3mBOagwE0TlBIqulhMlQg+5U8Sb/M3kHN48
++qvWBkofZ6aYMBzdLNvcGJVXZsb/XItW9XcCAwEAAaNjMGEwDwYDVR0TAQH/BAUwAwEB/zAfBgNV
+HSMEGDAWgBT5YLvU49U09rj1BoAlp3PbRmmonjAdBgNVHQ4EFgQU+WC71OPVNPa49QaAJadz20Zp
+qJ4wDgYDVR0PAQH/BAQDAgGGMA0GCSqGSIb3DQEBCwUAA4ICAQBWs47LCp1Jjr+kxJG7ZhcFUZh1
+++VQLHqe8RT6q9OKPv+RKY9ji9i0qVQBDb6Thi/5Sm3HXvVX+cpVHBK+Rw82xd9qt9t1wkclf7nx
+Y/hoLVUE0fKNsKTPvDxeH3jnpaAgcLAExbf3cqfeIg29MyVGjGSSJuM+LmOW2puMPfgYCdcDzH2G
+guDKBAdRUNf/ktUM79qGn5nX67evaOI5JpS6aLe/g9Pqemc9YmeuJeVy6OLk7K4S9ksrPJ/psEDz
+OFSz/bdoyNrGj1E8svuR3Bznm53htw1yj+KkxKl4+esUrMZDBcJlOSgYAsOCsp0FvmXtll9ldDz7
+CTUue5wT/RsPXcdtgTpWD8w74a8CLyKsRspGPKAcTNZEtF4uXBVmCeEmKf7GUmG6sXP/wwyc5Wxq
+lD8UykAWlYTzWamsX0xhk23RO8yilQwipmdnRC652dKKQbNmC1r7fSOl8hqw/96bg5Qu0T/fkreR
+rwU7ZcegbLHNYhLDkBvjJc40vG93drEQw/cFGsDWr3RiSBd3kmmQYRzelYB0VI8YHMPzA9C/pEN1
+hlMYegouCRw2n5H9gooiS9EOUCXdywMMF8mDAAhONU2Ki+3wApRmLER/y5UnlhetCTCstnEXbosX
+9hwJ1C07mKVx01QT2WDz9UtmT/rx7iASjbSsV7FFY6GsdqnC+w==
+-----END CERTIFICATE-----
+
+SSL.com EV Root Certification Authority ECC
+===========================================
+-----BEGIN CERTIFICATE-----
+MIIClDCCAhqgAwIBAgIILCmcWxbtBZUwCgYIKoZIzj0EAwIwfzELMAkGA1UEBhMCVVMxDjAMBgNV
+BAgMBVRleGFzMRAwDgYDVQQHDAdIb3VzdG9uMRgwFgYDVQQKDA9TU0wgQ29ycG9yYXRpb24xNDAy
+BgNVBAMMK1NTTC5jb20gRVYgUm9vdCBDZXJ0aWZpY2F0aW9uIEF1dGhvcml0eSBFQ0MwHhcNMTYw
+MjEyMTgxNTIzWhcNNDEwMjEyMTgxNTIzWjB/MQswCQYDVQQGEwJVUzEOMAwGA1UECAwFVGV4YXMx
+EDAOBgNVBAcMB0hvdXN0b24xGDAWBgNVBAoMD1NTTCBDb3Jwb3JhdGlvbjE0MDIGA1UEAwwrU1NM
+LmNvbSBFViBSb290IENlcnRpZmljYXRpb24gQXV0aG9yaXR5IEVDQzB2MBAGByqGSM49AgEGBSuB
+BAAiA2IABKoSR5CYG/vvw0AHgyBO8TCCogbR8pKGYfL2IWjKAMTH6kMAVIbc/R/fALhBYlzccBYy
+3h+Z1MzFB8gIH2EWB1E9fVwHU+M1OIzfzZ/ZLg1KthkuWnBaBu2+8KGwytAJKaNjMGEwHQYDVR0O
+BBYEFFvKXuXe0oGqzagtZFG22XKbl+ZPMA8GA1UdEwEB/wQFMAMBAf8wHwYDVR0jBBgwFoAUW8pe
+5d7SgarNqC1kUbbZcpuX5k8wDgYDVR0PAQH/BAQDAgGGMAoGCCqGSM49BAMCA2gAMGUCMQCK5kCJ
+N+vp1RPZytRrJPOwPYdGWBrssd9v+1a6cGvHOMzosYxPD/fxZ3YOg9AeUY8CMD32IygmTMZgh5Mm
+m7I1HrrW9zzRHM76JTymGoEVW/MSD2zuZYrJh6j5B+BimoxcSg==
+-----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
new file mode 100644
index 0000000000..5a84f6b0b1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Mozilla/mk-ca-bundle.pl
@@ -0,0 +1,553 @@
+#!/usr/bin/env perl
+# ***************************************************************************
+# * _ _ ____ _
+# * Project ___| | | | _ \| |
+# * / __| | | | |_) | |
+# * | (__| |_| | _ <| |___
+# * \___|\___/|_| \_\_____|
+# *
+# * Copyright (C) 1998 - 2016, 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.haxx.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;
+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.27';
+
+$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 "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";
+ 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;
+
+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 \*\*\*\*\*/);
+ }
+ }
+ elsif(/^# (Issuer|Serial Number|Subject|Not Valid Before|Not Valid After |Fingerprint \(MD5\)|Fingerprint \(SHA1\)):/) {
+ push @precert, $_;
+ next;
+ }
+ elsif(/^#|^\s*$/) {
+ undef @precert;
+ next;
+ }
+ chomp;
+
+ # 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/) {
+ my $data;
+ while (<TXT>) {
+ last if (/^END/);
+ chomp;
+ my @octets = split(/\\/);
+ shift @octets;
+ for (@octets) {
+ $data .= chr(oct);
+ }
+ }
+ # scan forwards until the trust part
+ while (<TXT>) {
+ last if (/^CKA_CLASS CK_OBJECT_CLASS CKO_NSS_TRUST/);
+ chomp;
+ }
+ # 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 ++;
+ } else {
+ 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));
+ if ($opt_t) {
+ foreach my $key (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
new file mode 100644
index 0000000000..fecfc38446
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP.pm
@@ -0,0 +1,307 @@
+package Net::HTTP;
+our $VERSION = '6.18';
+use strict;
+use warnings;
+
+use vars qw($SOCKET_CLASS);
+unless ($SOCKET_CLASS) {
+ # Try several, in order of capability and preference
+ if (eval { require IO::Socket::IP }) {
+ $SOCKET_CLASS = "IO::Socket::IP"; # IPv4+IPv6
+ } elsif (eval { require IO::Socket::INET6 }) {
+ $SOCKET_CLASS = "IO::Socket::INET6"; # IPv4+IPv6
+ } elsif (eval { require IO::Socket::INET }) {
+ $SOCKET_CLASS = "IO::Socket::INET"; # IPv4 only
+ } else {
+ require IO::Socket;
+ $SOCKET_CLASS = "IO::Socket::INET";
+ }
+}
+require Net::HTTP::Methods;
+require Carp;
+
+our @ISA = ($SOCKET_CLASS, 'Net::HTTP::Methods');
+
+sub new {
+ my $class = shift;
+ Carp::croak("No Host option provided") unless @_;
+ $class->SUPER::new(@_);
+}
+
+sub configure {
+ my($self, $cnf) = @_;
+ $self->http_configure($cnf);
+}
+
+sub http_connect {
+ my($self, $cnf) = @_;
+ $self->SUPER::configure($cnf);
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Net::HTTP - Low-level HTTP connection (client)
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ use Net::HTTP;
+ my $s = Net::HTTP->new(Host => "www.perl.com") || die $@;
+ $s->write_request(GET => "/", 'User-Agent' => "Mozilla/5.0");
+ my($code, $mess, %h) = $s->read_response_headers;
+
+ while (1) {
+ my $buf;
+ my $n = $s->read_entity_body($buf, 1024);
+ die "read failed: $!" unless defined $n;
+ last unless $n;
+ print $buf;
+ }
+
+=head1 DESCRIPTION
+
+The C<Net::HTTP> class is a low-level HTTP client. An instance of the
+C<Net::HTTP> class represents a connection to an HTTP server. The
+HTTP protocol is described in RFC 2616. The C<Net::HTTP> class
+supports C<HTTP/1.0> and C<HTTP/1.1>.
+
+C<Net::HTTP> is a sub-class of one of C<IO::Socket::IP> (IPv6+IPv4),
+C<IO::Socket::INET6> (IPv6+IPv4), or C<IO::Socket::INET> (IPv4 only).
+You can mix the methods described below with reading and writing from the
+socket directly. This is not necessary a good idea, unless you know what
+you are doing.
+
+The following methods are provided (in addition to those of
+C<IO::Socket::INET>):
+
+=over
+
+=item $s = Net::HTTP->new( %options )
+
+The C<Net::HTTP> constructor method takes the same options as
+C<IO::Socket::INET>'s as well as these:
+
+ Host: Initial host attribute value
+ KeepAlive: Initial keep_alive attribute value
+ SendTE: Initial send_te attribute_value
+ HTTPVersion: Initial http_version attribute value
+ PeerHTTPVersion: Initial peer_http_version attribute value
+ MaxLineLength: Initial max_line_length attribute value
+ MaxHeaderLines: Initial max_header_lines attribute value
+
+The C<Host> option is also the default for C<IO::Socket::INET>'s
+C<PeerAddr>. The C<PeerPort> defaults to 80 if not provided.
+The C<PeerPort> specification can also be embedded in the C<PeerAddr>
+by preceding it with a ":", and closing the IPv6 address on brackets "[]" if
+necessary: "192.0.2.1:80","[2001:db8::1]:80","any.example.com:80".
+
+The C<Listen> option provided by C<IO::Socket::INET>'s constructor
+method is not allowed.
+
+If unable to connect to the given HTTP server then the constructor
+returns C<undef> and $@ contains the reason. After a successful
+connect, a C<Net:HTTP> object is returned.
+
+=item $s->host
+
+Get/set the default value of the C<Host> header to send. The $host
+must not be set to an empty string (or C<undef>) for HTTP/1.1.
+
+=item $s->keep_alive
+
+Get/set the I<keep-alive> value. If this value is TRUE then the
+request will be sent with headers indicating that the server should try
+to keep the connection open so that multiple requests can be sent.
+
+The actual headers set will depend on the value of the C<http_version>
+and C<peer_http_version> attributes.
+
+=item $s->send_te
+
+Get/set the a value indicating if the request will be sent with a "TE"
+header to indicate the transfer encodings that the server can choose to
+use. The list of encodings announced as accepted by this client depends
+on availability of the following modules: C<Compress::Raw::Zlib> for
+I<deflate>, and C<IO::Compress::Gunzip> for I<gzip>.
+
+=item $s->http_version
+
+Get/set the HTTP version number that this client should announce.
+This value can only be set to "1.0" or "1.1". The default is "1.1".
+
+=item $s->peer_http_version
+
+Get/set the protocol version number of our peer. This value will
+initially be "1.0", but will be updated by a successful
+read_response_headers() method call.
+
+=item $s->max_line_length
+
+Get/set a limit on the length of response line and response header
+lines. The default is 8192. A value of 0 means no limit.
+
+=item $s->max_header_length
+
+Get/set a limit on the number of header lines that a response can
+have. The default is 128. A value of 0 means no limit.
+
+=item $s->format_request($method, $uri, %headers, [$content])
+
+Format a request message and return it as a string. If the headers do
+not include a C<Host> header, then a header is inserted with the value
+of the C<host> attribute. Headers like C<Connection> and
+C<Keep-Alive> might also be added depending on the status of the
+C<keep_alive> attribute.
+
+If $content is given (and it is non-empty), then a C<Content-Length>
+header is automatically added unless it was already present.
+
+=item $s->write_request($method, $uri, %headers, [$content])
+
+Format and send a request message. Arguments are the same as for
+format_request(). Returns true if successful.
+
+=item $s->format_chunk( $data )
+
+Returns the string to be written for the given chunk of data.
+
+=item $s->write_chunk($data)
+
+Will write a new chunk of request entity body data. This method
+should only be used if the C<Transfer-Encoding> header with a value of
+C<chunked> was sent in the request. Note, writing zero-length data is
+a no-op. Use the write_chunk_eof() method to signal end of entity
+body data.
+
+Returns true if successful.
+
+=item $s->format_chunk_eof( %trailers )
+
+Returns the string to be written for signaling EOF when a
+C<Transfer-Encoding> of C<chunked> is used.
+
+=item $s->write_chunk_eof( %trailers )
+
+Will write eof marker for chunked data and optional trailers. Note
+that trailers should not really be used unless is was signaled
+with a C<Trailer> header.
+
+Returns true if successful.
+
+=item ($code, $mess, %headers) = $s->read_response_headers( %opts )
+
+Read response headers from server and return it. The $code is the 3
+digit HTTP status code (see L<HTTP::Status>) and $mess is the textual
+message that came with it. Headers are then returned as key/value
+pairs. Since key letter casing is not normalized and the same key can
+even occur multiple times, assigning these values directly to a hash
+is not wise. Only the $code is returned if this method is called in
+scalar context.
+
+As a side effect this method updates the 'peer_http_version'
+attribute.
+
+Options might be passed in as key/value pairs. There are currently
+only two options supported; C<laxed> and C<junk_out>.
+
+The C<laxed> option will make read_response_headers() more forgiving
+towards servers that have not learned how to speak HTTP properly. The
+C<laxed> option is a boolean flag, and is enabled by passing in a TRUE
+value. The C<junk_out> option can be used to capture bad header lines
+when C<laxed> is enabled. The value should be an array reference.
+Bad header lines will be pushed onto the array.
+
+The C<laxed> option must be specified in order to communicate with
+pre-HTTP/1.0 servers that don't describe the response outcome or the
+data they send back with a header block. For these servers
+peer_http_version is set to "0.9" and this method returns (200,
+"Assumed OK").
+
+The method will raise an exception (die) if the server does not speak
+proper HTTP or if the C<max_line_length> or C<max_header_length>
+limits are reached. If the C<laxed> option is turned on and
+C<max_line_length> and C<max_header_length> checks are turned off,
+then no exception will be raised and this method will always
+return a response code.
+
+=item $n = $s->read_entity_body($buf, $size);
+
+Reads chunks of the entity body content. Basically the same interface
+as for read() and sysread(), but the buffer offset argument is not
+supported yet. This method should only be called after a successful
+read_response_headers() call.
+
+The return value will be C<undef> on read errors, 0 on EOF, -1 if no data
+could be returned this time, otherwise the number of bytes assigned
+to $buf. The $buf is set to "" when the return value is -1.
+
+You normally want to retry this call if this function returns either
+-1 or C<undef> with C<$!> as EINTR or EAGAIN (see L<Errno>). EINTR
+can happen if the application catches signals and EAGAIN can happen if
+you made the socket non-blocking.
+
+This method will raise exceptions (die) if the server does not speak
+proper HTTP. This can only happen when reading chunked data.
+
+=item %headers = $s->get_trailers
+
+After read_entity_body() has returned 0 to indicate end of the entity
+body, you might call this method to pick up any trailers.
+
+=item $s->_rbuf
+
+Get/set the read buffer content. The read_response_headers() and
+read_entity_body() methods use an internal buffer which they will look
+for data before they actually sysread more from the socket itself. If
+they read too much, the remaining data will be left in this buffer.
+
+=item $s->_rbuf_length
+
+Returns the number of bytes in the read buffer. This should always be
+the same as:
+
+ length($s->_rbuf)
+
+but might be more efficient.
+
+=back
+
+=head1 SUBCLASSING
+
+The read_response_headers() and read_entity_body() will invoke the
+sysread() method when they need more data. Subclasses might want to
+override this method to control how reading takes place.
+
+The object itself is a glob. Subclasses should avoid using hash key
+names prefixed with C<http_> and C<io_>.
+
+=head1 SEE ALSO
+
+L<LWP>, L<IO::Socket::INET>, L<Net::HTTP::NB>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2001-2017 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.
+
+=cut
+
+__END__
+
+# ABSTRACT: Low-level HTTP connection (client)
+
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
new file mode 100644
index 0000000000..c682e3fc25
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/Methods.pm
@@ -0,0 +1,669 @@
+package Net::HTTP::Methods;
+our $VERSION = '6.18';
+use strict;
+use warnings;
+use URI;
+
+my $CRLF = "\015\012"; # "\r\n" is not portable
+
+*_bytes = defined(&utf8::downgrade) ?
+ sub {
+ unless (utf8::downgrade($_[0], 1)) {
+ require Carp;
+ Carp::croak("Wide character in HTTP request (bytes required)");
+ }
+ return $_[0];
+ }
+ :
+ sub {
+ return $_[0];
+ };
+
+
+sub new {
+ my $class = shift;
+ unshift(@_, "Host") if @_ == 1;
+ my %cnf = @_;
+ require Symbol;
+ my $self = bless Symbol::gensym(), $class;
+ return $self->http_configure(\%cnf);
+}
+
+sub http_configure {
+ my($self, $cnf) = @_;
+
+ die "Listen option not allowed" if $cnf->{Listen};
+ my $explicit_host = (exists $cnf->{Host});
+ my $host = delete $cnf->{Host};
+ my $peer = $cnf->{PeerAddr} || $cnf->{PeerHost};
+ if (!$peer) {
+ die "No Host option provided" unless $host;
+ $cnf->{PeerAddr} = $peer = $host;
+ }
+
+ # CONNECTIONS
+ # PREFER: port number from PeerAddr, then PeerPort, then http_default_port
+ my $peer_uri = URI->new("http://$peer");
+ $cnf->{"PeerPort"} = $peer_uri->_port || $cnf->{PeerPort} || $self->http_default_port;
+ $cnf->{"PeerAddr"} = $peer_uri->host;
+
+ # HOST header:
+ # If specified but blank, ignore.
+ # If specified with a value, add the port number
+ # If not specified, set to PeerAddr and port number
+ # ALWAYS: If IPv6 address, use [brackets] (thanks to the URI package)
+ # ALWAYS: omit port number if http_default_port
+ if (($host) || (! $explicit_host)) {
+ my $uri = ($explicit_host) ? URI->new("http://$host") : $peer_uri->clone;
+ if (!$uri->_port) {
+ # Always use *our* $self->http_default_port instead of URI's (Covers HTTP, HTTPS)
+ $uri->port( $cnf->{PeerPort} || $self->http_default_port);
+ }
+ my $host_port = $uri->host_port; # Returns host:port or [ipv6]:port
+ my $remove = ":" . $self->http_default_port; # we want to remove the default port number
+ if (substr($host_port,0-length($remove)) eq $remove) {
+ substr($host_port,0-length($remove)) = "";
+ }
+ $host = $host_port;
+ }
+
+ $cnf->{Proto} = 'tcp';
+
+ my $keep_alive = delete $cnf->{KeepAlive};
+ my $http_version = delete $cnf->{HTTPVersion};
+ $http_version = "1.1" unless defined $http_version;
+ my $peer_http_version = delete $cnf->{PeerHTTPVersion};
+ $peer_http_version = "1.0" unless defined $peer_http_version;
+ my $send_te = delete $cnf->{SendTE};
+ my $max_line_length = delete $cnf->{MaxLineLength};
+ $max_line_length = 8*1024 unless defined $max_line_length;
+ my $max_header_lines = delete $cnf->{MaxHeaderLines};
+ $max_header_lines = 128 unless defined $max_header_lines;
+
+ return undef unless $self->http_connect($cnf);
+
+ $self->host($host);
+ $self->keep_alive($keep_alive);
+ $self->send_te($send_te);
+ $self->http_version($http_version);
+ $self->peer_http_version($peer_http_version);
+ $self->max_line_length($max_line_length);
+ $self->max_header_lines($max_header_lines);
+
+ ${*$self}{'http_buf'} = "";
+
+ return $self;
+}
+
+sub http_default_port {
+ 80;
+}
+
+# set up property accessors
+for my $method (qw(host keep_alive send_te max_line_length max_header_lines peer_http_version)) {
+ my $prop_name = "http_" . $method;
+ no strict 'refs';
+ *$method = sub {
+ my $self = shift;
+ my $old = ${*$self}{$prop_name};
+ ${*$self}{$prop_name} = shift if @_;
+ return $old;
+ };
+}
+
+# we want this one to be a bit smarter
+sub http_version {
+ my $self = shift;
+ my $old = ${*$self}{'http_version'};
+ if (@_) {
+ my $v = shift;
+ $v = "1.0" if $v eq "1"; # float
+ unless ($v eq "1.0" or $v eq "1.1") {
+ require Carp;
+ Carp::croak("Unsupported HTTP version '$v'");
+ }
+ ${*$self}{'http_version'} = $v;
+ }
+ $old;
+}
+
+sub format_request {
+ my $self = shift;
+ my $method = shift;
+ my $uri = shift;
+
+ my $content = (@_ % 2) ? pop : "";
+
+ for ($method, $uri) {
+ require Carp;
+ Carp::croak("Bad method or uri") if /\s/ || !length;
+ }
+
+ push(@{${*$self}{'http_request_method'}}, $method);
+ my $ver = ${*$self}{'http_version'};
+ my $peer_ver = ${*$self}{'http_peer_http_version'} || "1.0";
+
+ my @h;
+ my @connection;
+ my %given = (host => 0, "content-length" => 0, "te" => 0);
+ while (@_) {
+ my($k, $v) = splice(@_, 0, 2);
+ my $lc_k = lc($k);
+ if ($lc_k eq "connection") {
+ $v =~ s/^\s+//;
+ $v =~ s/\s+$//;
+ push(@connection, split(/\s*,\s*/, $v));
+ next;
+ }
+ if (exists $given{$lc_k}) {
+ $given{$lc_k}++;
+ }
+ push(@h, "$k: $v");
+ }
+
+ if (length($content) && !$given{'content-length'}) {
+ push(@h, "Content-Length: " . length($content));
+ }
+
+ my @h2;
+ if ($given{te}) {
+ push(@connection, "TE") unless grep lc($_) eq "te", @connection;
+ }
+ elsif ($self->send_te && gunzip_ok()) {
+ # gzip is less wanted since the IO::Uncompress::Gunzip interface for
+ # it does not really allow chunked decoding to take place easily.
+ push(@h2, "TE: deflate,gzip;q=0.3");
+ push(@connection, "TE");
+ }
+
+ unless (grep lc($_) eq "close", @connection) {
+ if ($self->keep_alive) {
+ if ($peer_ver eq "1.0") {
+ # from looking at Netscape's headers
+ push(@h2, "Keep-Alive: 300");
+ unshift(@connection, "Keep-Alive");
+ }
+ }
+ else {
+ push(@connection, "close") if $ver ge "1.1";
+ }
+ }
+ push(@h2, "Connection: " . join(", ", @connection)) if @connection;
+ unless ($given{host}) {
+ my $h = ${*$self}{'http_host'};
+ push(@h2, "Host: $h") if $h;
+ }
+
+ return _bytes(join($CRLF, "$method $uri HTTP/$ver", @h2, @h, "", $content));
+}
+
+
+sub write_request {
+ my $self = shift;
+ $self->print($self->format_request(@_));
+}
+
+sub format_chunk {
+ my $self = shift;
+ return $_[0] unless defined($_[0]) && length($_[0]);
+ return _bytes(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF);
+}
+
+sub write_chunk {
+ my $self = shift;
+ return 1 unless defined($_[0]) && length($_[0]);
+ $self->print(_bytes(sprintf("%x", length($_[0])) . $CRLF . $_[0] . $CRLF));
+}
+
+sub format_chunk_eof {
+ my $self = shift;
+ my @h;
+ while (@_) {
+ push(@h, sprintf "%s: %s$CRLF", splice(@_, 0, 2));
+ }
+ return _bytes(join("", "0$CRLF", @h, $CRLF));
+}
+
+sub write_chunk_eof {
+ my $self = shift;
+ $self->print($self->format_chunk_eof(@_));
+}
+
+
+sub my_read {
+ die if @_ > 3;
+ my $self = shift;
+ my $len = $_[1];
+ for (${*$self}{'http_buf'}) {
+ if (length) {
+ $_[0] = substr($_, 0, $len, "");
+ return length($_[0]);
+ }
+ else {
+ die "read timeout" unless $self->can_read;
+ return $self->sysread($_[0], $len);
+ }
+ }
+}
+
+
+sub my_readline {
+ my $self = shift;
+ my $what = shift;
+ for (${*$self}{'http_buf'}) {
+ my $max_line_length = ${*$self}{'http_max_line_length'};
+ my $pos;
+ while (1) {
+ # find line ending
+ $pos = index($_, "\012");
+ last if $pos >= 0;
+ die "$what line too long (limit is $max_line_length)"
+ if $max_line_length && length($_) > $max_line_length;
+
+ # need to read more data to find a line ending
+ my $new_bytes = 0;
+
+ READ:
+ { # wait until bytes start arriving
+ $self->can_read
+ or die "read timeout";
+
+ # consume all incoming bytes
+ my $bytes_read = $self->sysread($_, 1024, length);
+ if(defined $bytes_read) {
+ $new_bytes += $bytes_read;
+ }
+ elsif($!{EINTR} || $!{EAGAIN} || $!{EWOULDBLOCK}) {
+ redo READ;
+ }
+ else {
+ # if we have already accumulated some data let's at
+ # least return that as a line
+ length or die "$what read failed: $!";
+ }
+
+ # no line-ending, no new bytes
+ return length($_) ? substr($_, 0, length($_), "") : undef
+ if $new_bytes==0;
+ }
+ }
+ die "$what line too long ($pos; limit is $max_line_length)"
+ if $max_line_length && $pos > $max_line_length;
+
+ my $line = substr($_, 0, $pos+1, "");
+ $line =~ s/(\015?\012)\z// || die "Assert";
+ return wantarray ? ($line, $1) : $line;
+ }
+}
+
+
+sub can_read {
+ my $self = shift;
+ return 1 unless defined(fileno($self));
+ return 1 if $self->isa('IO::Socket::SSL') && $self->pending;
+ return 1 if $self->isa('Net::SSL') && $self->can('pending') && $self->pending;
+
+ # With no timeout, wait forever. An explicit timeout of 0 can be
+ # used to just check if the socket is readable without waiting.
+ my $timeout = @_ ? shift : (${*$self}{io_socket_timeout} || undef);
+
+ my $fbits = '';
+ vec($fbits, fileno($self), 1) = 1;
+ SELECT:
+ {
+ my $before;
+ $before = time if $timeout;
+ my $nfound = select($fbits, undef, undef, $timeout);
+ if ($nfound < 0) {
+ if ($!{EINTR} || $!{EAGAIN} || $!{EWOULDBLOCK}) {
+ # don't really think EAGAIN/EWOULDBLOCK can happen here
+ if ($timeout) {
+ $timeout -= time - $before;
+ $timeout = 0 if $timeout < 0;
+ }
+ redo SELECT;
+ }
+ die "select failed: $!";
+ }
+ return $nfound > 0;
+ }
+}
+
+
+sub _rbuf {
+ my $self = shift;
+ if (@_) {
+ for (${*$self}{'http_buf'}) {
+ my $old;
+ $old = $_ if defined wantarray;
+ $_ = shift;
+ return $old;
+ }
+ }
+ else {
+ return ${*$self}{'http_buf'};
+ }
+}
+
+sub _rbuf_length {
+ my $self = shift;
+ return length ${*$self}{'http_buf'};
+}
+
+
+sub _read_header_lines {
+ my $self = shift;
+ my $junk_out = shift;
+
+ my @headers;
+ my $line_count = 0;
+ my $max_header_lines = ${*$self}{'http_max_header_lines'};
+ while (my $line = my_readline($self, 'Header')) {
+ if ($line =~ /^(\S+?)\s*:\s*(.*)/s) {
+ push(@headers, $1, $2);
+ }
+ elsif (@headers && $line =~ s/^\s+//) {
+ $headers[-1] .= " " . $line;
+ }
+ elsif ($junk_out) {
+ push(@$junk_out, $line);
+ }
+ else {
+ die "Bad header: '$line'\n";
+ }
+ if ($max_header_lines) {
+ $line_count++;
+ if ($line_count >= $max_header_lines) {
+ die "Too many header lines (limit is $max_header_lines)";
+ }
+ }
+ }
+ return @headers;
+}
+
+
+sub read_response_headers {
+ my($self, %opt) = @_;
+ my $laxed = $opt{laxed};
+
+ my($status, $eol) = my_readline($self, 'Status');
+ unless (defined $status) {
+ die "Server closed connection without sending any data back";
+ }
+
+ my($peer_ver, $code, $message) = split(/\s+/, $status, 3);
+ if (!$peer_ver || $peer_ver !~ s,^HTTP/,, || $code !~ /^[1-5]\d\d$/) {
+ die "Bad response status line: '$status'" unless $laxed;
+ # assume HTTP/0.9
+ ${*$self}{'http_peer_http_version'} = "0.9";
+ ${*$self}{'http_status'} = "200";
+ substr(${*$self}{'http_buf'}, 0, 0) = $status . ($eol || "");
+ return 200 unless wantarray;
+ return (200, "Assumed OK");
+ };
+
+ ${*$self}{'http_peer_http_version'} = $peer_ver;
+ ${*$self}{'http_status'} = $code;
+
+ my $junk_out;
+ if ($laxed) {
+ $junk_out = $opt{junk_out} || [];
+ }
+ my @headers = $self->_read_header_lines($junk_out);
+
+ # pick out headers that read_entity_body might need
+ my @te;
+ my $content_length;
+ for (my $i = 0; $i < @headers; $i += 2) {
+ my $h = lc($headers[$i]);
+ if ($h eq 'transfer-encoding') {
+ my $te = $headers[$i+1];
+ $te =~ s/^\s+//;
+ $te =~ s/\s+$//;
+ push(@te, $te) if length($te);
+ }
+ elsif ($h eq 'content-length') {
+ # ignore bogus and overflow values
+ if ($headers[$i+1] =~ /^\s*(\d{1,15})(?:\s|$)/) {
+ $content_length = $1;
+ }
+ }
+ }
+ ${*$self}{'http_te'} = join(",", @te);
+ ${*$self}{'http_content_length'} = $content_length;
+ ${*$self}{'http_first_body'}++;
+ delete ${*$self}{'http_trailers'};
+ return $code unless wantarray;
+ return ($code, $message, @headers);
+}
+
+
+sub read_entity_body {
+ my $self = shift;
+ my $buf_ref = \$_[0];
+ my $size = $_[1];
+ die "Offset not supported yet" if $_[2];
+
+ my $chunked;
+ my $bytes;
+
+ if (${*$self}{'http_first_body'}) {
+ ${*$self}{'http_first_body'} = 0;
+ delete ${*$self}{'http_chunked'};
+ delete ${*$self}{'http_bytes'};
+ my $method = shift(@{${*$self}{'http_request_method'}});
+ my $status = ${*$self}{'http_status'};
+ if ($method eq "HEAD") {
+ # this response is always empty regardless of other headers
+ $bytes = 0;
+ }
+ elsif (my $te = ${*$self}{'http_te'}) {
+ my @te = split(/\s*,\s*/, lc($te));
+ die "Chunked must be last Transfer-Encoding '$te'"
+ unless pop(@te) eq "chunked";
+ pop(@te) while @te && $te[-1] eq "chunked"; # ignore repeated chunked spec
+
+ for (@te) {
+ if ($_ eq "deflate" && inflate_ok()) {
+ #require Compress::Raw::Zlib;
+ my ($i, $status) = Compress::Raw::Zlib::Inflate->new();
+ die "Can't make inflator: $status" unless $i;
+ $_ = sub { my $out; $i->inflate($_[0], \$out); $out }
+ }
+ elsif ($_ eq "gzip" && gunzip_ok()) {
+ #require IO::Uncompress::Gunzip;
+ my @buf;
+ $_ = sub {
+ push(@buf, $_[0]);
+ return "" unless $_[1];
+ my $input = join("", @buf);
+ my $output;
+ IO::Uncompress::Gunzip::gunzip(\$input, \$output, Transparent => 0)
+ or die "Can't gunzip content: $IO::Uncompress::Gunzip::GunzipError";
+ return \$output;
+ };
+ }
+ elsif ($_ eq "identity") {
+ $_ = sub { $_[0] };
+ }
+ else {
+ die "Can't handle transfer encoding '$te'";
+ }
+ }
+
+ @te = reverse(@te);
+
+ ${*$self}{'http_te2'} = @te ? \@te : "";
+ $chunked = -1;
+ }
+ elsif (defined(my $content_length = ${*$self}{'http_content_length'})) {
+ $bytes = $content_length;
+ }
+ elsif ($status =~ /^(?:1|[23]04)/) {
+ # RFC 2616 says that these responses should always be empty
+ # but that does not appear to be true in practice [RT#17907]
+ $bytes = 0;
+ }
+ else {
+ # XXX Multi-Part types are self delimiting, but RFC 2616 says we
+ # only has to deal with 'multipart/byteranges'
+
+ # Read until EOF
+ }
+ }
+ else {
+ $chunked = ${*$self}{'http_chunked'};
+ $bytes = ${*$self}{'http_bytes'};
+ }
+
+ if (defined $chunked) {
+ # The state encoded in $chunked is:
+ # $chunked == 0: read CRLF after chunk, then chunk header
+ # $chunked == -1: read chunk header
+ # $chunked > 0: bytes left in current chunk to read
+
+ if ($chunked <= 0) {
+ my $line = my_readline($self, 'Entity body');
+ if ($chunked == 0) {
+ die "Missing newline after chunk data: '$line'"
+ if !defined($line) || $line ne "";
+ $line = my_readline($self, 'Entity body');
+ }
+ die "EOF when chunk header expected" unless defined($line);
+ my $chunk_len = $line;
+ $chunk_len =~ s/;.*//; # ignore potential chunk parameters
+ unless ($chunk_len =~ /^([\da-fA-F]+)\s*$/) {
+ die "Bad chunk-size in HTTP response: $line";
+ }
+ $chunked = hex($1);
+ ${*$self}{'http_chunked'} = $chunked;
+ if ($chunked == 0) {
+ ${*$self}{'http_trailers'} = [$self->_read_header_lines];
+ $$buf_ref = "";
+
+ my $n = 0;
+ if (my $transforms = delete ${*$self}{'http_te2'}) {
+ for (@$transforms) {
+ $$buf_ref = &$_($$buf_ref, 1);
+ }
+ $n = length($$buf_ref);
+ }
+
+ # in case somebody tries to read more, make sure we continue
+ # to return EOF
+ delete ${*$self}{'http_chunked'};
+ ${*$self}{'http_bytes'} = 0;
+
+ return $n;
+ }
+ }
+
+ my $n = $chunked;
+ $n = $size if $size && $size < $n;
+ $n = my_read($self, $$buf_ref, $n);
+ return undef unless defined $n;
+
+ ${*$self}{'http_chunked'} = $chunked - $n;
+
+ if ($n > 0) {
+ if (my $transforms = ${*$self}{'http_te2'}) {
+ for (@$transforms) {
+ $$buf_ref = &$_($$buf_ref, 0);
+ }
+ $n = length($$buf_ref);
+ $n = -1 if $n == 0;
+ }
+ }
+ return $n;
+ }
+ elsif (defined $bytes) {
+ unless ($bytes) {
+ $$buf_ref = "";
+ return 0;
+ }
+ my $n = $bytes;
+ $n = $size if $size && $size < $n;
+ $n = my_read($self, $$buf_ref, $n);
+ ${*$self}{'http_bytes'} = defined $n ? $bytes - $n : $bytes;
+ return $n;
+ }
+ else {
+ # read until eof
+ $size ||= 8*1024;
+ return my_read($self, $$buf_ref, $size);
+ }
+}
+
+sub get_trailers {
+ my $self = shift;
+ @{${*$self}{'http_trailers'} || []};
+}
+
+BEGIN {
+my $gunzip_ok;
+my $inflate_ok;
+
+sub gunzip_ok {
+ return $gunzip_ok if defined $gunzip_ok;
+
+ # Try to load IO::Uncompress::Gunzip.
+ local $@;
+ local $SIG{__DIE__};
+ $gunzip_ok = 0;
+
+ eval {
+ require IO::Uncompress::Gunzip;
+ $gunzip_ok++;
+ };
+
+ return $gunzip_ok;
+}
+
+sub inflate_ok {
+ return $inflate_ok if defined $inflate_ok;
+
+ # Try to load Compress::Raw::Zlib.
+ local $@;
+ local $SIG{__DIE__};
+ $inflate_ok = 0;
+
+ eval {
+ require Compress::Raw::Zlib;
+ $inflate_ok++;
+ };
+
+ return $inflate_ok;
+}
+
+} # BEGIN
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Net::HTTP::Methods - Methods shared by Net::HTTP and Net::HTTPS
+
+=head1 VERSION
+
+version 6.18
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2001-2017 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.
+
+=cut
+
+__END__
+
+# ABSTRACT: Methods shared by Net::HTTP and Net::HTTPS
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
new file mode 100644
index 0000000000..ff70563409
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTP/NB.pm
@@ -0,0 +1,121 @@
+package Net::HTTP::NB;
+our $VERSION = '6.18';
+use strict;
+use warnings;
+
+use base 'Net::HTTP';
+
+sub can_read {
+ return 1;
+}
+
+sub sysread {
+ my $self = $_[0];
+ if (${*$self}{'httpnb_read_count'}++) {
+ ${*$self}{'http_buf'} = ${*$self}{'httpnb_save'};
+ die "Multi-read\n";
+ }
+ my $buf;
+ my $offset = $_[3] || 0;
+ my $n = sysread($self, $_[1], $_[2], $offset);
+ ${*$self}{'httpnb_save'} .= substr($_[1], $offset);
+ return $n;
+}
+
+sub read_response_headers {
+ my $self = shift;
+ ${*$self}{'httpnb_read_count'} = 0;
+ ${*$self}{'httpnb_save'} = ${*$self}{'http_buf'};
+ my @h = eval { $self->SUPER::read_response_headers(@_) };
+ if ($@) {
+ return if $@ eq "Multi-read\n";
+ die;
+ }
+ return @h;
+}
+
+sub read_entity_body {
+ my $self = shift;
+ ${*$self}{'httpnb_read_count'} = 0;
+ ${*$self}{'httpnb_save'} = ${*$self}{'http_buf'};
+ # XXX I'm not so sure this does the correct thing in case of
+ # transfer-encoding transforms
+ my $n = eval { $self->SUPER::read_entity_body(@_); };
+ if ($@) {
+ $_[0] = "";
+ return -1;
+ }
+ return $n;
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Net::HTTP::NB - Non-blocking HTTP client
+
+=head1 VERSION
+
+version 6.18
+
+=head1 SYNOPSIS
+
+ use Net::HTTP::NB;
+ my $s = Net::HTTP::NB->new(Host => "www.perl.com") || die $@;
+ $s->write_request(GET => "/");
+
+ use IO::Select;
+ my $sel = IO::Select->new($s);
+
+ READ_HEADER: {
+ die "Header timeout" unless $sel->can_read(10);
+ my($code, $mess, %h) = $s->read_response_headers;
+ redo READ_HEADER unless $code;
+ }
+
+ while (1) {
+ die "Body timeout" unless $sel->can_read(10);
+ my $buf;
+ my $n = $s->read_entity_body($buf, 1024);
+ last unless $n;
+ print $buf;
+ }
+
+=head1 DESCRIPTION
+
+Same interface as C<Net::HTTP> but it will never try multiple reads
+when the read_response_headers() or read_entity_body() methods are
+invoked. This make it possible to multiplex multiple Net::HTTP::NB
+using select without risk blocking.
+
+If read_response_headers() did not see enough data to complete the
+headers an empty list is returned.
+
+If read_entity_body() did not see new entity data in its read
+the value -1 is returned.
+
+=head1 SEE ALSO
+
+L<Net::HTTP>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2001-2017 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.
+
+=cut
+
+__END__
+
+#ABSTRACT: Non-blocking HTTP client
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm
new file mode 100644
index 0000000000..2ec04b6e0f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Net/HTTPS.pm
@@ -0,0 +1,135 @@
+package Net::HTTPS;
+our $VERSION = '6.18';
+use strict;
+use warnings;
+
+# Figure out which SSL implementation to use
+use vars qw($SSL_SOCKET_CLASS);
+if ($SSL_SOCKET_CLASS) {
+ # somebody already set it
+}
+elsif ($SSL_SOCKET_CLASS = $ENV{PERL_NET_HTTPS_SSL_SOCKET_CLASS}) {
+ unless ($SSL_SOCKET_CLASS =~ /^(IO::Socket::SSL|Net::SSL)\z/) {
+ die "Bad socket class [$SSL_SOCKET_CLASS]";
+ }
+ eval "require $SSL_SOCKET_CLASS";
+ die $@ if $@;
+}
+elsif ($IO::Socket::SSL::VERSION) {
+ $SSL_SOCKET_CLASS = "IO::Socket::SSL"; # it was already loaded
+}
+elsif ($Net::SSL::VERSION) {
+ $SSL_SOCKET_CLASS = "Net::SSL";
+}
+else {
+ eval { require IO::Socket::SSL; };
+ if ($@) {
+ my $old_errsv = $@;
+ eval {
+ require Net::SSL; # from Crypt-SSLeay
+ };
+ if ($@) {
+ $old_errsv =~ s/\s\(\@INC contains:.*\)/)/g;
+ die $old_errsv . $@;
+ }
+ $SSL_SOCKET_CLASS = "Net::SSL";
+ }
+ else {
+ $SSL_SOCKET_CLASS = "IO::Socket::SSL";
+ }
+}
+
+require Net::HTTP::Methods;
+
+our @ISA=($SSL_SOCKET_CLASS, 'Net::HTTP::Methods');
+
+sub configure {
+ my($self, $cnf) = @_;
+ $self->http_configure($cnf);
+}
+
+sub http_connect {
+ my($self, $cnf) = @_;
+ if ($self->isa("Net::SSL")) {
+ if ($cnf->{SSL_verify_mode}) {
+ if (my $f = $cnf->{SSL_ca_file}) {
+ $ENV{HTTPS_CA_FILE} = $f;
+ }
+ if (my $f = $cnf->{SSL_ca_path}) {
+ $ENV{HTTPS_CA_DIR} = $f;
+ }
+ }
+ if ($cnf->{SSL_verifycn_scheme}) {
+ $@ = "Net::SSL from Crypt-SSLeay can't verify hostnames; either install IO::Socket::SSL or turn off verification by setting the PERL_LWP_SSL_VERIFY_HOSTNAME environment variable to 0";
+ return undef;
+ }
+ }
+ $self->SUPER::configure($cnf);
+}
+
+sub http_default_port {
+ 443;
+}
+
+if ($SSL_SOCKET_CLASS eq "Net::SSL") {
+ # The underlying SSLeay classes fails to work if the socket is
+ # placed in non-blocking mode. This override of the blocking
+ # method makes sure it stays the way it was created.
+ *blocking = sub { };
+}
+
+1;
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Net::HTTPS - Low-level HTTP over SSL/TLS connection (client)
+
+=head1 VERSION
+
+version 6.18
+
+=head1 DESCRIPTION
+
+The C<Net::HTTPS> is a low-level HTTP over SSL/TLS client. The interface is the same
+as the interface for C<Net::HTTP>, but the constructor takes additional parameters
+as accepted by L<IO::Socket::SSL>. The C<Net::HTTPS> object is an C<IO::Socket::SSL>
+too, which makes it inherit additional methods from that base class.
+
+For historical reasons this module also supports using C<Net::SSL> (from the
+Crypt-SSLeay distribution) as its SSL driver and base class. This base is
+automatically selected if available and C<IO::Socket::SSL> isn't. You might
+also force which implementation to use by setting $Net::HTTPS::SSL_SOCKET_CLASS
+before loading this module. If not set this variable is initialized from the
+C<PERL_NET_HTTPS_SSL_SOCKET_CLASS> environment variable.
+
+=head1 ENVIRONMENT
+
+You might set the C<PERL_NET_HTTPS_SSL_SOCKET_CLASS> environment variable to the name
+of the base SSL implementation (and Net::HTTPS base class) to use. The default
+is C<IO::Socket::SSL>. Currently the only other supported value is C<Net::SSL>.
+
+=head1 SEE ALSO
+
+L<Net::HTTP>, L<IO::Socket::SSL>
+
+=head1 AUTHOR
+
+Gisle Aas <gisle@activestate.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2001-2017 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.
+
+=cut
+
+__END__
+
+#ABSTRACT: Low-level HTTP over SSL/TLS connection (client)
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/OLE.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/OLE.pm
new file mode 100644
index 0000000000..234f6986ab
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/OLE.pm
@@ -0,0 +1,177 @@
+# Compatibility layer for applications using the old toplevel OLE.pm.
+# New code should use Win32::OLE
+
+# This file is based on ../lib/OLE.pm from ActiveState build 315.
+
+# Compatibility notes:
+# - "GetObject" -> "GetActiveObject"
+# - "keys %$collection" -> "Win32::OLE::Enum->All($collection)"
+# or "in $Collection"
+# - "unnamed" default method retries
+
+########################################################################
+# package Win32;
+########################################################################
+
+*Win32::OLELastError = sub { return OLE->LastError() };
+
+
+########################################################################
+package OLE::Variant;
+########################################################################
+
+use Win32::OLE qw(CP_ACP);
+use Win32::OLE::Variant;
+
+use strict;
+use vars qw($AUTOLOAD @ISA $LCID $CP $Warn $LastError $_NewEnum $_Unique);
+@ISA = qw(Win32::OLE::Variant);
+
+$Warn = 0;
+$LCID = 2 << 10; # LOCALE_SYSTEM_DEFAULT
+$CP = CP_ACP;
+$_NewEnum = 0;
+$_Unique = 0;
+
+sub new {
+ my $self = shift;
+ my $variant = $self->SUPER::new(@_);
+ $OLE::LastError = $Win32::OLE->LastError unless defined $variant;
+ return $variant;
+}
+
+
+########################################################################
+package OLE::Tie;
+########################################################################
+use strict;
+use vars qw(@ISA);
+@ISA = qw(Win32::OLE::Tie);
+
+# !!! It is VERY important that Win32::OLE::Tie::DESTROY gets called. !!!
+# If you subclass DESTROY, don't forget to call $self->SUPER::DESTROY.
+# Otherwise the OLE interfaces will not be released until process termination!
+
+# Retry default method if property doesn't exist
+sub FETCH {
+ my ($self,$key) = @_;
+ return $self->SUPER::Fetch($key, 1);
+}
+
+sub STORE {
+ my ($self,$key,$value) = @_;
+ $self->SUPER::Store($key, $value, 1);
+}
+
+# Enumerate collection members, not object properties
+*FIRSTKEY = *Win32::OLE::Tie::FIRSTENUM;
+*NEXTKEY = *Win32::OLE::Tie::NEXTENUM;
+
+
+########################################################################
+package OLE;
+########################################################################
+use Win32::OLE qw(CP_ACP);
+
+# Use OleInitialize() instead of CoInitializeEx:
+Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE);
+
+use strict;
+
+# Disable overload; unfortunately "no overload" doesn't do it :-(
+# Overloading is no longer enabled by default in Win32::OLE
+#use overload '""' => sub {overload::StrVal($_[0])},
+# '0+' => sub {overload::StrVal($_[0])};
+
+use vars qw($AUTOLOAD @ISA $LCID $CP $Warn $LastError $Tie);
+@ISA = qw(Win32::OLE);
+
+$Warn = 0;
+$LCID = 2 << 10; # LOCALE_SYSTEM_DEFAULT
+$CP = CP_ACP;
+$Tie = 'OLE::Tie';
+
+sub new {
+ my $class = shift;
+ $class = shift if $class eq 'OLE';
+ return OLE->SUPER::new($class);
+}
+
+sub copy {
+ my $class = shift;
+ $class = shift if $class eq 'OLE';
+ return OLE->SUPER::GetActiveObject($class);
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $retval;
+ $AUTOLOAD =~ s/.*:://o;
+
+ Carp::croak("Cannot autoload class method \"$AUTOLOAD\"")
+ unless ref($self) && UNIVERSAL::isa($self,'OLE');
+
+ local $^H = 0; # !hack alert!
+ unless (defined $self->Dispatch($AUTOLOAD, $retval, @_)) {
+ # Retry default method
+ $self->Dispatch(undef, $retval, $AUTOLOAD, @_);
+ }
+ return $retval;
+}
+
+*CreateObject = \&new;
+*GetObject = \&copy;
+
+# Automation data types.
+
+sub VT_EMPTY {0;}
+sub VT_NULL {1;}
+sub VT_I2 {2;}
+sub VT_I4 {3;}
+sub VT_R4 {4;}
+sub VT_R8 {5;}
+sub VT_CY {6;}
+sub VT_DATE {7;}
+sub VT_BSTR {8;}
+sub VT_DISPATCH {9;}
+sub VT_ERROR {10;}
+sub VT_BOOL {11;}
+sub VT_VARIANT {12;}
+sub VT_UNKNOWN {13;}
+sub VT_I1 {16;}
+sub VT_UI1 {17;}
+sub VT_UI2 {18;}
+sub VT_UI4 {19;}
+sub VT_I8 {20;}
+sub VT_UI8 {21;}
+sub VT_INT {22;}
+sub VT_UINT {23;}
+sub VT_VOID {24;}
+sub VT_HRESULT {25;}
+sub VT_PTR {26;}
+sub VT_SAFEARRAY {27;}
+sub VT_CARRAY {28;}
+sub VT_USERDEFINED {29;}
+sub VT_LPSTR {30;}
+sub VT_LPWSTR {31;}
+sub VT_FILETIME {64;}
+sub VT_BLOB {65;}
+sub VT_STREAM {66;}
+sub VT_STORAGE {67;}
+sub VT_STREAMED_OBJECT {68;}
+sub VT_STORED_OBJECT {69;}
+sub VT_BLOB_OBJECT {70;}
+sub VT_CF {71;}
+sub VT_CLSID {72;}
+
+sub TKIND_ENUM {0;}
+sub TKIND_RECORD {1;}
+sub TKIND_MODULE {2;}
+sub TKIND_INTERFACE {3;}
+sub TKIND_DISPATCH {4;}
+sub TKIND_COCLASS {5;}
+sub TKIND_ALIAS {6;}
+sub TKIND_UNION {7;}
+sub TKIND_MAX {8;}
+
+1;
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 100644
index 0000000000..2c6b5e45d0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Socket.pm
@@ -0,0 +1,1138 @@
+package Socket;
+
+use strict;
+{ use 5.006001; }
+
+our $VERSION = '2.029';
+
+=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 contants 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_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();
+
+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,
+ AI_IDN_ALLOW_UNASSIGNED => 256,
+ AI_IDN_USE_STD3_ASCII_RULES => 512,
+ NI_IDN => 32,
+ NI_IDN_ALLOW_UNASSIGNED => 64,
+ NI_IDN_USE_STD3_ASCII_RULES => 128,
+
+ # 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()|AI_IDN_ALLOW_UNASSIGNED()|AI_IDN_USE_STD3_ASCII_RULES()) 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()|NI_IDN_ALLOW_UNASSIGNED()|NI_IDN_USE_STD3_ASCII_RULES()) 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/Test/Fatal.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm
new file mode 100644
index 0000000000..29aa6629fb
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Fatal.pm
@@ -0,0 +1,364 @@
+use strict;
+use warnings;
+package Test::Fatal;
+# ABSTRACT: incredibly simple helpers for testing code with exceptions
+$Test::Fatal::VERSION = '0.014';
+#pod =head1 SYNOPSIS
+#pod
+#pod use Test::More;
+#pod use Test::Fatal;
+#pod
+#pod use System::Under::Test qw(might_die);
+#pod
+#pod is(
+#pod exception { might_die; },
+#pod undef,
+#pod "the code lived",
+#pod );
+#pod
+#pod like(
+#pod exception { might_die; },
+#pod qr/turns out it died/,
+#pod "the code died as expected",
+#pod );
+#pod
+#pod isa_ok(
+#pod exception { might_die; },
+#pod 'Exception::Whatever',
+#pod 'the thrown exception',
+#pod );
+#pod
+#pod =head1 DESCRIPTION
+#pod
+#pod Test::Fatal is an alternative to the popular L<Test::Exception>. It does much
+#pod less, but should allow greater flexibility in testing exception-throwing code
+#pod with about the same amount of typing.
+#pod
+#pod It exports one routine by default: C<exception>.
+#pod
+#pod =cut
+
+use Carp ();
+use Try::Tiny 0.07;
+
+use Exporter 5.57 'import';
+
+our @EXPORT = qw(exception);
+our @EXPORT_OK = qw(exception success dies_ok lives_ok);
+
+#pod =func exception
+#pod
+#pod my $exception = exception { ... };
+#pod
+#pod C<exception> takes a bare block of code and returns the exception thrown by
+#pod that block. If no exception was thrown, it returns undef.
+#pod
+#pod B<Achtung!> If the block results in a I<false> exception, such as 0 or the
+#pod empty string, Test::Fatal itself will die. Since either of these cases
+#pod indicates a serious problem with the system under testing, this behavior is
+#pod considered a I<feature>. If you must test for these conditions, you should use
+#pod L<Try::Tiny>'s try/catch mechanism. (Try::Tiny is the underlying exception
+#pod handling system of Test::Fatal.)
+#pod
+#pod Note that there is no TAP assert being performed. In other words, no "ok" or
+#pod "not ok" line is emitted. It's up to you to use the rest of C<exception> in an
+#pod existing test like C<ok>, C<isa_ok>, C<is>, et cetera. Or you may wish to use
+#pod the C<dies_ok> and C<lives_ok> wrappers, which do provide TAP output.
+#pod
+#pod C<exception> does I<not> alter the stack presented to the called block, meaning
+#pod that if the exception returned has a stack trace, it will include some frames
+#pod between the code calling C<exception> and the thing throwing the exception.
+#pod This is considered a I<feature> because it avoids the occasionally twitchy
+#pod C<Sub::Uplevel> mechanism.
+#pod
+#pod B<Achtung!> This is not a great idea:
+#pod
+#pod sub exception_like(&$;$) {
+#pod my ($code, $pattern, $name) = @_;
+#pod like( &exception($code), $pattern, $name );
+#pod }
+#pod
+#pod exception_like(sub { }, qr/foo/, 'foo appears in the exception');
+#pod
+#pod If the code in the C<...> is going to throw a stack trace with the arguments to
+#pod each subroutine in its call stack (for example via C<Carp::confess>,
+#pod the test name, "foo appears in the exception" will itself be matched by the
+#pod regex. Instead, write this:
+#pod
+#pod like( exception { ... }, qr/foo/, 'foo appears in the exception' );
+#pod
+#pod B<Achtung>: One final bad idea:
+#pod
+#pod isnt( exception { ... }, undef, "my code died!");
+#pod
+#pod It's true that this tests that your code died, but you should really test that
+#pod it died I<for the right reason>. For example, if you make an unrelated mistake
+#pod in the block, like using the wrong dereference, your test will pass even though
+#pod the code to be tested isn't really run at all. If you're expecting an
+#pod inspectable exception with an identifier or class, test that. If you're
+#pod expecting a string exception, consider using C<like>.
+#pod
+#pod =cut
+
+our ($REAL_TBL, $REAL_CALCULATED_TBL) = (1, 1);
+
+sub exception (&) {
+ my $code = shift;
+
+ return try {
+ my $incremented = $Test::Builder::Level - $REAL_CALCULATED_TBL;
+ local $Test::Builder::Level = $REAL_CALCULATED_TBL;
+ if ($incremented) {
+ # each call to exception adds 5 stack frames
+ $Test::Builder::Level += 5;
+ for my $i (1..$incremented) {
+ # -2 because we want to see it from the perspective of the call to
+ # is() within the call to $code->()
+ my $caller = caller($Test::Builder::Level - 2);
+ if ($caller eq __PACKAGE__) {
+ # each call to exception adds 5 stack frames
+ $Test::Builder::Level = $Test::Builder::Level + 5;
+ }
+ else {
+ $Test::Builder::Level = $Test::Builder::Level + 1;
+ }
+ }
+ }
+
+ local $REAL_CALCULATED_TBL = $Test::Builder::Level;
+ $code->();
+ return undef;
+ } catch {
+ return $_ if $_;
+
+ my $problem = defined $_ ? 'false' : 'undef';
+ Carp::confess("$problem exception caught by Test::Fatal::exception");
+ };
+}
+
+#pod =func success
+#pod
+#pod try {
+#pod should_live;
+#pod } catch {
+#pod fail("boo, we died");
+#pod } success {
+#pod pass("hooray, we lived");
+#pod };
+#pod
+#pod C<success>, exported only by request, is a L<Try::Tiny> helper with semantics
+#pod identical to L<C<finally>|Try::Tiny/finally>, but the body of the block will
+#pod only be run if the C<try> block ran without error.
+#pod
+#pod Although almost any needed exception tests can be performed with C<exception>,
+#pod success blocks may sometimes help organize complex testing.
+#pod
+#pod =cut
+
+sub success (&;@) {
+ my $code = shift;
+ return finally( sub {
+ return if @_; # <-- only run on success
+ $code->();
+ }, @_ );
+}
+
+#pod =func dies_ok
+#pod
+#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 These provide an easy upgrade path for replacing existing unit tests based on
+#pod C<Test::Exception>.
+#pod
+#pod RJBS does not suggest using this except as a convenience while porting tests to
+#pod use Test::Fatal's C<exception> routine.
+#pod
+#pod use Test::More tests => 2;
+#pod use Test::Fatal qw(dies_ok lives_ok);
+#pod
+#pod dies_ok { die "I failed" } 'code that fails';
+#pod
+#pod lives_ok { return "I'm still alive" } 'code that does not fail';
+#pod
+#pod =cut
+
+my $Tester;
+
+# Signature should match that of Test::Exception
+sub dies_ok (&;$) {
+ my $code = shift;
+ my $name = shift;
+
+ require Test::Builder;
+ $Tester ||= Test::Builder->new;
+
+ my $ok = $Tester->ok( exception( \&$code ), $name );
+ $ok or $Tester->diag( "expected an exception but none was raised" );
+ return $ok;
+}
+
+sub lives_ok (&;$) {
+ my $code = shift;
+ my $name = shift;
+
+ require Test::Builder;
+ $Tester ||= Test::Builder->new;
+
+ my $ok = $Tester->ok( !exception( \&$code ), $name );
+ $ok or $Tester->diag( "expected return but an exception was raised" );
+ return $ok;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test::Fatal - incredibly simple helpers for testing code with exceptions
+
+=head1 VERSION
+
+version 0.014
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use Test::Fatal;
+
+ use System::Under::Test qw(might_die);
+
+ is(
+ exception { might_die; },
+ undef,
+ "the code lived",
+ );
+
+ like(
+ exception { might_die; },
+ qr/turns out it died/,
+ "the code died as expected",
+ );
+
+ isa_ok(
+ exception { might_die; },
+ 'Exception::Whatever',
+ 'the thrown exception',
+ );
+
+=head1 DESCRIPTION
+
+Test::Fatal is an alternative to the popular L<Test::Exception>. It does much
+less, but should allow greater flexibility in testing exception-throwing code
+with about the same amount of typing.
+
+It exports one routine by default: C<exception>.
+
+=head1 FUNCTIONS
+
+=head2 exception
+
+ my $exception = exception { ... };
+
+C<exception> takes a bare block of code and returns the exception thrown by
+that block. If no exception was thrown, it returns undef.
+
+B<Achtung!> If the block results in a I<false> exception, such as 0 or the
+empty string, Test::Fatal itself will die. Since either of these cases
+indicates a serious problem with the system under testing, this behavior is
+considered a I<feature>. If you must test for these conditions, you should use
+L<Try::Tiny>'s try/catch mechanism. (Try::Tiny is the underlying exception
+handling system of Test::Fatal.)
+
+Note that there is no TAP assert being performed. In other words, no "ok" or
+"not ok" line is emitted. It's up to you to use the rest of C<exception> in an
+existing test like C<ok>, C<isa_ok>, C<is>, et cetera. Or you may wish to use
+the C<dies_ok> and C<lives_ok> wrappers, which do provide TAP output.
+
+C<exception> does I<not> alter the stack presented to the called block, meaning
+that if the exception returned has a stack trace, it will include some frames
+between the code calling C<exception> and the thing throwing the exception.
+This is considered a I<feature> because it avoids the occasionally twitchy
+C<Sub::Uplevel> mechanism.
+
+B<Achtung!> This is not a great idea:
+
+ sub exception_like(&$;$) {
+ my ($code, $pattern, $name) = @_;
+ like( &exception($code), $pattern, $name );
+ }
+
+ exception_like(sub { }, qr/foo/, 'foo appears in the exception');
+
+If the code in the C<...> is going to throw a stack trace with the arguments to
+each subroutine in its call stack (for example via C<Carp::confess>,
+the test name, "foo appears in the exception" will itself be matched by the
+regex. Instead, write this:
+
+ like( exception { ... }, qr/foo/, 'foo appears in the exception' );
+
+B<Achtung>: One final bad idea:
+
+ isnt( exception { ... }, undef, "my code died!");
+
+It's true that this tests that your code died, but you should really test that
+it died I<for the right reason>. For example, if you make an unrelated mistake
+in the block, like using the wrong dereference, your test will pass even though
+the code to be tested isn't really run at all. If you're expecting an
+inspectable exception with an identifier or class, test that. If you're
+expecting a string exception, consider using C<like>.
+
+=head2 success
+
+ try {
+ should_live;
+ } catch {
+ fail("boo, we died");
+ } success {
+ pass("hooray, we lived");
+ };
+
+C<success>, exported only by request, is a L<Try::Tiny> helper with semantics
+identical to L<C<finally>|Try::Tiny/finally>, but the body of the block will
+only be run if the C<try> block ran without error.
+
+Although almost any needed exception tests can be performed with C<exception>,
+success blocks may sometimes help organize complex testing.
+
+=head2 dies_ok
+
+=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.
+These provide an easy upgrade path for replacing existing unit tests based on
+C<Test::Exception>.
+
+RJBS does not suggest using this except as a convenience while porting tests to
+use Test::Fatal's C<exception> routine.
+
+ use Test::More tests => 2;
+ use Test::Fatal qw(dies_ok lives_ok);
+
+ dies_ok { die "I failed" } 'code that fails';
+
+ lives_ok { return "I'm still alive" } 'code that does not fail';
+
+=head1 AUTHOR
+
+Ricardo Signes <rjbs@cpan.org>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2010 by Ricardo Signes.
+
+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/Test/Needs.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm
new file mode 100644
index 0000000000..f3db264d31
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/Needs.pm
@@ -0,0 +1,315 @@
+package Test::Needs;
+use strict;
+use warnings;
+no warnings 'once';
+our $VERSION = '0.002005';
+$VERSION =~ tr/_//d;
+
+BEGIN {
+ *_WORK_AROUND_HINT_LEAKAGE
+ = "$]" < 5.011 && !("$]" >= 5.009004 && "$]" < 5.010001)
+ ? sub(){1} : sub(){0};
+ *_WORK_AROUND_BROKEN_MODULE_STATE
+ = "$]" < 5.009
+ ? sub(){1} : sub(){0};
+}
+
+sub _try_require {
+ local %^H
+ if _WORK_AROUND_HINT_LEAKAGE;
+ my ($module) = @_;
+ (my $file = "$module.pm") =~ s{::|'}{/}g;
+ my $err;
+ {
+ local $@;
+ eval { require $file }
+ or $err = $@;
+ }
+ if (defined $err) {
+ delete $INC{$file}
+ if _WORK_AROUND_BROKEN_MODULE_STATE;
+ die $err
+ unless $err =~ /\ACan't locate \Q$file\E/;
+ return !1;
+ }
+ !0;
+}
+
+sub _find_missing {
+ my @bad = map {
+ my ($module, $version) = @$_;
+ if ($module eq 'perl') {
+ $version
+ = !$version ? 0
+ : $version =~ /^[0-9]+\.[0-9]+$/ ? sprintf('%.6f', $version)
+ : $version =~ /^v?([0-9]+(?:\.[0-9]+)+)$/ ? do {
+ my @p = split /\./, $1;
+ push @p, 0
+ until @p >= 3;
+ sprintf '%d.%03d%03d', @p;
+ }
+ : $version =~ /^\x05..?$/s ? do {
+ my @p = map ord, split //, $version;
+ push @p, 0
+ until @p >= 3;
+ sprintf '%d.%03d%03d', @p;
+ }
+ : do {
+ use warnings FATAL => 'numeric';
+ no warnings 'void';
+ eval { 0 + $version; 1 } ? $version
+ : die sprintf qq{version "%s" for perl does not look like a number at %s line %s.\n},
+ $version, (caller( 1 + ($Test::Builder::Level||0) ))[1,2];
+ };
+ if ("$]" < $version) {
+ sprintf "perl %s (have %.6f)", $version, $];
+ }
+ else {
+ ();
+ }
+ }
+ elsif ($module =~ /^\d|[^\w:]|:::|[^:]:[^:]|^:|:$/) {
+ die sprintf qq{"%s" does not look like a module name at %s line %s.\n},
+ $module, (caller( 1 + ($Test::Builder::Level||0) ))[1,2];
+ die
+ }
+ elsif (_try_require($module)) {
+ local $@;
+ if (defined $version && !eval { $module->VERSION($version); 1 }) {
+ "$module $version (have ".$module->VERSION.')';
+ }
+ else {
+ ();
+ }
+ }
+ else {
+ $version ? "$module $version" : $module;
+ }
+ }
+ map {
+ if (ref eq 'HASH') {
+ my $arg = $_;
+ map [ $_ => $arg->{$_} ], sort keys %$arg;
+ }
+ elsif (ref eq 'ARRAY') {
+ my $arg = $_;
+ map [ @{$arg}[$_*2,$_*2+1] ], 0 .. int($#$arg / 2);
+ }
+ else {
+ [ $_ => undef ];
+ }
+ } @_;
+ @bad ? "Need " . join(', ', @bad) : undef;
+}
+
+sub import {
+ my $class = shift;
+ my $target = caller;
+ if (@_) {
+ local $Test::Builder::Level = ($Test::Builder::Level||0) + 1;
+ test_needs(@_);
+ }
+ no strict 'refs';
+ *{"${target}::test_needs"} = \&test_needs;
+}
+
+sub test_needs {
+ my $missing = _find_missing(@_);
+ local $Test::Builder::Level = ($Test::Builder::Level||0) + 1;
+ _fail_or_skip($missing, $ENV{RELEASE_TESTING})
+ if $missing;
+}
+
+sub _skip { _fail_or_skip($_[0], 0) }
+sub _fail { _fail_or_skip($_[0], 1) }
+
+sub _fail_or_skip {
+ my ($message, $fail) = @_;
+ if ($INC{'Test2/API.pm'}) {
+ my $ctx = Test2::API::context();
+ my $hub = $ctx->hub;
+ if ($fail) {
+ $ctx->ok(0, "Test::Needs modules available", [$message]);
+ }
+ else {
+ my $plan = $hub->plan;
+ my $tests = $hub->count;
+ if ($plan || $tests) {
+ my $skips
+ = $plan && $plan ne 'NO PLAN' ? $plan - $tests : 1;
+ $ctx->skip("Test::Needs modules not available") for 1 .. $skips;
+ $ctx->note($message);
+ }
+ else {
+ $ctx->plan(0, 'SKIP', $message);
+ }
+ }
+ $ctx->done_testing;
+ $ctx->release if $Test2::API::VERSION < 1.302053;
+ $ctx->send_event('+'._t2_terminate_event());
+ }
+ elsif ($INC{'Test/Builder.pm'}) {
+ 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' } };
+ if ($fail) {
+ $tb->plan(tests => 1)
+ unless $tb->$has_plan;
+ $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;
+ Test::Builer->can('note') ? $tb->note($message) : print "# $message\n";
+ }
+ else {
+ $tb->skip_all($message);
+ }
+ }
+ $tb->done_testing
+ if Test::Builder->can('done_testing');
+ die bless {} => 'Test::Builder::Exception'
+ if Test::Builder->can('parent') && $tb->parent;
+ }
+ else {
+ if ($fail) {
+ print "1..1\n";
+ print "not ok 1 - Test::Needs modules available\n";
+ print STDERR "# $message\n";
+ exit 1;
+ }
+ else {
+ print "1..0 # SKIP $message\n";
+ }
+ }
+ exit 0;
+}
+
+my $terminate_event;
+sub _t2_terminate_event () {
+ local $@;
+ $terminate_event ||= eval q{
+ $INC{'Test/Needs/Event/Terminate.pm'} = $INC{'Test/Needs.pm'};
+ package # hide
+ Test::Needs::Event::Terminate;
+ use Test2::Event ();
+ our @ISA = qw(Test2::Event);
+ sub no_display { 1 }
+ sub terminate { 0 }
+ __PACKAGE__;
+ } or die "$@";
+}
+
+1;
+__END__
+
+=pod
+
+=encoding utf-8
+
+=head1 NAME
+
+Test::Needs - Skip tests when modules not available
+
+=head1 SYNOPSIS
+
+ # need one module
+ use Test::Needs 'Some::Module';
+
+ # need multiple modules
+ use Test::Needs 'Some::Module', 'Some::Other::Module';
+
+ # need a given version of a module
+ use Test::Needs {
+ 'Some::Module' => '1.005',
+ };
+
+ # check later
+ use Test::Needs;
+ test_needs 'Some::Module';
+
+ # skips remainder of subtest
+ use Test::More;
+ use Test::Needs;
+ subtest 'my subtest' => sub {
+ test_needs 'Some::Module';
+ ...
+ };
+
+ # check perl version
+ use Test::Needs { perl => 5.020 };
+
+=head1 DESCRIPTION
+
+Skip test scripts if modules are not available. The requested modules will be
+loaded, and optionally have their versions checked. If the module is missing,
+the test script will be skipped. Modules that are found but fail to compile
+will exit with an error rather than skip.
+
+If used in a subtest, the remainder of the subtest will be skipped.
+
+Skipping will work even if some tests have already been run, or if a plan has
+been declared.
+
+Versions are checked via a C<< $module->VERSION($wanted_version) >> call.
+Versions must be provided in a format that will be accepted. No extra
+processing is done on them.
+
+If C<perl> is used as a module, the version is checked against the running perl
+version (L<$]|perlvar/$]>). The version can be specified as a number,
+dotted-decimal string, v-string, or version object.
+
+If the C<RELEASE_TESTING> environment variable is set, the tests will fail
+rather than skip. Subtests will be aborted, but the test script will continue
+running after that point.
+
+=head1 EXPORTS
+
+=head2 test_needs
+
+Has the same interface as when using Test::Needs in a C<use>.
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<Test::Requires>
+
+A similar module, with some important differences. L<Test::Requires> will act
+as a C<use> statement (despite its name), calling the import sub. Under
+C<RELEASE_TESTING>, it will BAIL_OUT if a module fails to load rather than
+using a normal test fail. It also doesn't distinguish between missing modules
+and broken modules.
+
+=item L<Test2::Require::Module>
+
+Part of the L<Test2> ecosystem. Only supports running as a C<use> command to
+skip an entire plan.
+
+=back
+
+=head1 AUTHOR
+
+haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
+
+=head1 CONTRIBUTORS
+
+None so far.
+
+=head1 COPYRIGHT
+
+Copyright (c) 2016 the Test::Needs L</AUTHOR> and L</CONTRIBUTORS>
+as listed above.
+
+=head1 LICENSE
+
+This library is free software and may be distributed under the same terms
+as perl itself. See L<http://dev.perl.org/licenses/>.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm
new file mode 100644
index 0000000000..e78ca0bc6d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Test/RequiresInternet.pm
@@ -0,0 +1,131 @@
+use strict;
+use warnings;
+package Test::RequiresInternet;
+$Test::RequiresInternet::VERSION = '0.05';
+# ABSTRACT: Easily test network connectivity
+
+
+use Socket;
+
+sub import {
+ skip_all("NO_NETWORK_TESTING") if env("NO_NETWORK_TESTING");
+
+ my $namespace = shift;
+
+ my $argc = scalar @_;
+ if ( $argc == 0 ) {
+ push @_, 'www.google.com', 80;
+ }
+ elsif ( $argc % 2 != 0 ) {
+ die "Must supply server and a port pairs. You supplied " . (join ", ", @_) . "\n";
+ }
+
+ while ( @_ ) {
+ my $host = shift;
+ my $port = shift;
+
+ local $@;
+
+ eval {make_socket($host, $port)};
+
+ if ( $@ ) {
+ skip_all("$@");
+ }
+ }
+}
+
+sub make_socket {
+ my ($host, $port) = @_;
+
+ my $portnum;
+ if ($port =~ /\D/) {
+ $portnum = getservbyname($port, "tcp");
+ }
+ else {
+ $portnum = $port;
+ }
+
+ die "Could not find a port number for $port\n" if not $portnum;
+
+ my $iaddr = inet_aton($host) or die "no host: $host\n";
+
+ my $paddr = sockaddr_in($portnum, $iaddr);
+ my $proto = getprotobyname("tcp");
+
+ socket(my $sock, PF_INET, SOCK_STREAM, $proto) or die "socket: $!\n";
+ connect($sock, $paddr) or die "connect: $!\n";
+ close ($sock) or die "close: $!\n";
+
+ 1;
+}
+
+sub env {
+ exists $ENV{$_[0]} && $ENV{$_[0]} eq '1'
+}
+
+sub skip_all {
+ my $reason = shift;
+ print "1..0 # Skipped: $reason";
+ exit 0;
+}
+
+1;
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Test::RequiresInternet - Easily test network connectivity
+
+=head1 VERSION
+
+version 0.05
+
+=head1 SYNOPSIS
+
+ use Test::More;
+ use Test::RequiresInternet ('www.example.com' => 80, 'foobar.io' => 25);
+
+ # if you reach here, sockets successfully connected to hosts/ports above
+ plan tests => 1;
+
+ ok(do_that_internet_thing());
+
+=head1 OVERVIEW
+
+This module is intended to easily test network connectivity before functional
+tests begin to non-local Internet resources. It does not require any modules
+beyond those supplied in core Perl.
+
+If you do not specify a host/port pair, then the module defaults to using
+C<www.google.com> on port C<80>.
+
+You may optionally specify the port by its name, as in C<http> or C<ldap>.
+If you do this, the test module will attempt to look up the port number
+using C<getservbyname>.
+
+If you do specify a host and port, they must be specified in B<pairs>. It is a
+fatal error to omit one or the other.
+
+If the environment variable C<NO_NETWORK_TESTING> is set, then the tests
+will be skipped without attempting any socket connections.
+
+If the sockets cannot connect to the specified hosts and ports, the exception
+is caught, reported and the tests skipped.
+
+=head1 AUTHOR
+
+Mark Allen <mrallen1@yahoo.com>
+
+=head1 COPYRIGHT AND LICENSE
+
+This software is copyright (c) 2014 by Mark Allen.
+
+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/Tie/Registry.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Tie/Registry.pm
new file mode 100644
index 0000000000..2ded338d34
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Tie/Registry.pm
@@ -0,0 +1,45 @@
+package Tie::Registry;
+
+# Tie/Registry.pm -- Provides backward compatibility for Win32::TieRegistry
+# that was called Tie::Registry prior to version 0.20.
+# by Tye McQueen, tye@metronet.com, see http://www.metronet.com/~tye/.
+
+use strict;
+use Carp;
+
+use vars qw( $VERSION @ISA );
+BEGIN {
+ require Win32::TieRegistry;
+ $VERSION = '0.15';
+ @ISA = qw{Win32::TieRegistry};
+}
+
+sub import {
+ my $pkg = shift;
+ Win32::TieRegistry->import( ExportLevel => 1, SplitMultis => 0, @_ );
+}
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Tie::Registry - Legacy interface to Win32::TieRegistry (DEPRECATED)
+
+=head1 DESCRIPTION
+
+This module provides backward compatibility for L<Win32::TieRegistry>
+that was called Tie::Registry prior to version 0.20.
+
+=head1 AUTHOR
+
+Tye McQueen E<lt>tye@metronet.comE<gt>
+
+=head1 COPYRIGHT
+
+Copyright 1999 Tye McQueen.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Time/Zone.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Time/Zone.pm
new file mode 100644
index 0000000000..8a40f9158c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Time/Zone.pm
@@ -0,0 +1,291 @@
+
+package Time::Zone;
+
+=head1 NAME
+
+Time::Zone -- miscellaneous timezone manipulations routines
+
+=head1 SYNOPSIS
+
+ use Time::Zone;
+ print tz2zone();
+ print tz2zone($ENV{'TZ'});
+ print tz2zone($ENV{'TZ'}, time());
+ print tz2zone($ENV{'TZ'}, undef, $isdst);
+ $offset = tz_local_offset();
+ $offset = tz_offset($TZ);
+
+=head1 DESCRIPTION
+
+This is a collection of miscellaneous timezone manipulation routines.
+
+C<tz2zone()> parses the TZ environment variable and returns a timezone
+string suitable for inclusion in L<date(1)>-like output. It opionally takes
+a timezone string, a time, and a is-dst flag.
+
+C<tz_local_offset()> determins the offset from GMT time in seconds. It
+only does the calculation once.
+
+C<tz_offset()> determines the offset from GMT in seconds of a specified
+timezone.
+
+C<tz_name()> determines the name of the timezone based on its offset
+
+=head1 AUTHORS
+
+Graham Barr <gbarr@pobox.com>
+David Muir Sharnoff <muir@idiom.com>
+Paul Foley <paul@ascent.com>
+
+=cut
+
+require 5.002;
+
+require Exporter;
+use Carp;
+use strict;
+use vars qw(@ISA @EXPORT $VERSION @tz_local);
+
+@ISA = qw(Exporter);
+@EXPORT = qw(tz2zone tz_local_offset tz_offset tz_name);
+$VERSION = "2.24";
+
+# Parts stolen from code by Paul Foley <paul@ascent.com>
+
+sub tz2zone (;$$$)
+{
+ my($TZ, $time, $isdst) = @_;
+
+ use vars qw(%tzn_cache);
+
+ $TZ = defined($ENV{'TZ'}) ? ( $ENV{'TZ'} ? $ENV{'TZ'} : 'GMT' ) : ''
+ unless $TZ;
+
+ # Hack to deal with 'PST8PDT' format of TZ
+ # Note that this can't deal with all the esoteric forms, but it
+ # does recognize the most common: [:]STDoff[DST[off][,rule]]
+
+ if (! defined $isdst) {
+ my $j;
+ $time = time() unless $time;
+ ($j, $j, $j, $j, $j, $j, $j, $j, $isdst) = localtime($time);
+ }
+
+ if (defined $tzn_cache{$TZ}->[$isdst]) {
+ return $tzn_cache{$TZ}->[$isdst];
+ }
+
+ if ($TZ =~ /^
+ ( [^:\d+\-,] {3,} )
+ ( [+-] ?
+ \d {1,2}
+ ( : \d {1,2} ) {0,2}
+ )
+ ( [^\d+\-,] {3,} )?
+ /x
+ ) {
+ my $dsttz = defined($4) ? $4 : $1;
+ $TZ = $isdst ? $dsttz : $1;
+ $tzn_cache{$TZ} = [ $1, $dsttz ];
+ } else {
+ $tzn_cache{$TZ} = [ $TZ, $TZ ];
+ }
+ return $TZ;
+}
+
+sub tz_local_offset (;$)
+{
+ my ($time) = @_;
+
+ $time = time() unless $time;
+ my (@l) = localtime($time);
+ my $isdst = $l[8];
+
+ if (defined($tz_local[$isdst])) {
+ return $tz_local[$isdst];
+ }
+
+ $tz_local[$isdst] = &calc_off($time);
+
+ return $tz_local[$isdst];
+}
+
+sub calc_off
+{
+ my ($time) = @_;
+
+ my (@l) = localtime($time);
+ my (@g) = gmtime($time);
+
+ my $off;
+
+ $off = $l[0] - $g[0]
+ + ($l[1] - $g[1]) * 60
+ + ($l[2] - $g[2]) * 3600;
+
+ # subscript 7 is yday.
+
+ if ($l[7] == $g[7]) {
+ # done
+ } elsif ($l[7] == $g[7] + 1) {
+ $off += 86400;
+ } elsif ($l[7] == $g[7] - 1) {
+ $off -= 86400;
+ } elsif ($l[7] < $g[7]) {
+ # crossed over a year boundry!
+ # localtime is beginning of year, gmt is end
+ # therefore local is ahead
+ $off += 86400;
+ } else {
+ $off -= 86400;
+ }
+
+ return $off;
+}
+
+# constants
+
+CONFIG: {
+ use vars qw(%dstZone %zoneOff %dstZoneOff %Zone);
+
+ my @dstZone = (
+ # "ndt" => -2*3600-1800, # Newfoundland Daylight
+ "brst" => -2*3600, # Brazil Summer Time (East Daylight)
+ "adt" => -3*3600, # Atlantic Daylight
+ "edt" => -4*3600, # Eastern Daylight
+ "cdt" => -5*3600, # Central Daylight
+ "mdt" => -6*3600, # Mountain Daylight
+ "pdt" => -7*3600, # Pacific Daylight
+ "akdt" => -8*3600, # Alaska Daylight
+ "ydt" => -8*3600, # Yukon Daylight
+ "hdt" => -9*3600, # Hawaii Daylight
+ "bst" => +1*3600, # British Summer
+ "mest" => +2*3600, # Middle European Summer
+ "metdst" => +2*3600, # Middle European DST
+ "sst" => +2*3600, # Swedish Summer
+ "fst" => +2*3600, # French Summer
+ "cest" => +2*3600, # Central European Daylight
+ "eest" => +3*3600, # Eastern European Summer
+ "msd" => +4*3600, # Moscow Daylight
+ "wadt" => +8*3600, # West Australian Daylight
+ "kdt" => +10*3600, # Korean Daylight
+ # "cadt" => +10*3600+1800, # Central Australian Daylight
+ "aedt" => +11*3600, # Eastern Australian Daylight
+ "eadt" => +11*3600, # Eastern Australian Daylight
+ "nzd" => +13*3600, # New Zealand Daylight
+ "nzdt" => +13*3600, # New Zealand Daylight
+ );
+
+ my @Zone = (
+ "gmt" => 0, # Greenwich Mean
+ "ut" => 0, # Universal (Coordinated)
+ "utc" => 0,
+ "wet" => 0, # Western European
+ "wat" => -1*3600, # West Africa
+ "at" => -2*3600, # Azores
+ "fnt" => -2*3600, # Brazil Time (Extreme East - Fernando Noronha)
+ "brt" => -3*3600, # Brazil Time (East Standard - Brasilia)
+ # For completeness. BST is also British Summer, and GST is also Guam Standard.
+ # "bst" => -3*3600, # Brazil Standard
+ # "gst" => -3*3600, # Greenland Standard
+ # "nft" => -3*3600-1800,# Newfoundland
+ # "nst" => -3*3600-1800,# Newfoundland Standard
+ "mnt" => -4*3600, # Brazil Time (West Standard - Manaus)
+ "ewt" => -4*3600, # U.S. Eastern War Time
+ "ast" => -4*3600, # Atlantic Standard
+ "est" => -5*3600, # Eastern Standard
+ "act" => -5*3600, # Brazil Time (Extreme West - Acre)
+ "cst" => -6*3600, # Central Standard
+ "mst" => -7*3600, # Mountain Standard
+ "pst" => -8*3600, # Pacific Standard
+ "akst" => -9*3600, # Alaska Standard
+ "yst" => -9*3600, # Yukon Standard
+ "hst" => -10*3600, # Hawaii Standard
+ "cat" => -10*3600, # Central Alaska
+ "ahst" => -10*3600, # Alaska-Hawaii Standard
+ "nt" => -11*3600, # Nome
+ "idlw" => -12*3600, # International Date Line West
+ "cet" => +1*3600, # Central European
+ "mez" => +1*3600, # Central European (German)
+ "ect" => +1*3600, # Central European (French)
+ "met" => +1*3600, # Middle European
+ "mewt" => +1*3600, # Middle European Winter
+ "swt" => +1*3600, # Swedish Winter
+ "set" => +1*3600, # Seychelles
+ "fwt" => +1*3600, # French Winter
+ "eet" => +2*3600, # Eastern Europe, USSR Zone 1
+ "ukr" => +2*3600, # Ukraine
+ "bt" => +3*3600, # Baghdad, USSR Zone 2
+ "msk" => +3*3600, # Moscow
+ # "it" => +3*3600+1800,# Iran
+ "zp4" => +4*3600, # USSR Zone 3
+ "zp5" => +5*3600, # USSR Zone 4
+ # "ist" => +5*3600+1800,# Indian Standard
+ "zp6" => +6*3600, # USSR Zone 5
+ # For completeness. NST is also Newfoundland Stanard, and SST is also Swedish Summer.
+ # "nst" => +6*3600+1800,# North Sumatra
+ # "sst" => +7*3600, # South Sumatra, USSR Zone 6
+ # "jt" => +7*3600+1800,# Java (3pm in Cronusland!)
+ "wst" => +8*3600, # West Australian Standard
+ "hkt" => +8*3600, # Hong Kong
+ "cct" => +8*3600, # China Coast, USSR Zone 7
+ "jst" => +9*3600, # Japan Standard, USSR Zone 8
+ "kst" => +9*3600, # Korean Standard
+ # "cast" => +9*3600+1800,# Central Australian Standard
+ "aest" => +10*3600, # Eastern Australian Standard
+ "east" => +10*3600, # Eastern Australian Standard
+ "gst" => +10*3600, # Guam Standard, USSR Zone 9
+ "nzt" => +12*3600, # New Zealand
+ "nzst" => +12*3600, # New Zealand Standard
+ "idle" => +12*3600, # International Date Line East
+ );
+
+ %Zone = @Zone;
+ %dstZone = @dstZone;
+ %zoneOff = reverse(@Zone);
+ %dstZoneOff = reverse(@dstZone);
+
+}
+
+sub tz_offset (;$$)
+{
+ my ($zone, $time) = @_;
+
+ return &tz_local_offset($time) unless($zone);
+
+ $time = time() unless $time;
+ my(@l) = localtime($time);
+ my $dst = $l[8];
+
+ $zone = lc $zone;
+
+ if($zone =~ /^(([\-\+])\d\d?)(\d\d)$/) {
+ my $v = $2 . $3;
+ return $1 * 3600 + $v * 60;
+ } elsif (exists $dstZone{$zone} && ($dst || !exists $Zone{$zone})) {
+ return $dstZone{$zone};
+ } elsif(exists $Zone{$zone}) {
+ return $Zone{$zone};
+ }
+ undef;
+}
+
+sub tz_name (;$$)
+{
+ my ($off, $dst) = @_;
+
+ $off = tz_offset()
+ unless(defined $off);
+
+ $dst = (localtime(time))[8]
+ unless(defined $dst);
+
+ if (exists $dstZoneOff{$off} && ($dst || !exists $zoneOff{$off})) {
+ return $dstZoneOff{$off};
+ } elsif (exists $zoneOff{$off}) {
+ return $zoneOff{$off};
+ }
+ sprintf("%+05d", int($off / 60) * 100 + $off % 60);
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Try/Tiny.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Try/Tiny.pm
new file mode 100644
index 0000000000..14f5b09317
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Try/Tiny.pm
@@ -0,0 +1,813 @@
+package Try::Tiny; # git description: v0.29-2-g3b23a06
+use 5.006;
+# ABSTRACT: Minimal try/catch with proper preservation of $@
+
+our $VERSION = '0.30';
+
+use strict;
+use warnings;
+
+use Exporter 5.57 'import';
+our @EXPORT = our @EXPORT_OK = qw(try catch finally);
+
+use Carp;
+$Carp::Internal{+__PACKAGE__}++;
+
+BEGIN {
+ my $su = $INC{'Sub/Util.pm'} && defined &Sub::Util::set_subname;
+ my $sn = $INC{'Sub/Name.pm'} && eval { Sub::Name->VERSION(0.08) };
+ unless ($su || $sn) {
+ $su = eval { require Sub::Util; } && defined &Sub::Util::set_subname;
+ unless ($su) {
+ $sn = eval { require Sub::Name; Sub::Name->VERSION(0.08) };
+ }
+ }
+
+ *_subname = $su ? \&Sub::Util::set_subname
+ : $sn ? \&Sub::Name::subname
+ : sub { $_[1] };
+ *_HAS_SUBNAME = ($su || $sn) ? sub(){1} : sub(){0};
+}
+
+my %_finally_guards;
+
+# Need to prototype as @ not $$ because of the way Perl evaluates the prototype.
+# Keeping it at $$ means you only ever get 1 sub because we need to eval in a list
+# context & not a scalar one
+
+sub try (&;@) {
+ my ( $try, @code_refs ) = @_;
+
+ # we need to save this here, the eval block will be in scalar context due
+ # to $failed
+ my $wantarray = wantarray;
+
+ # work around perl bug by explicitly initializing these, due to the likelyhood
+ # this will be used in global destruction (perl rt#119311)
+ my ( $catch, @finally ) = ();
+
+ # find labeled blocks in the argument list.
+ # catch and finally tag the blocks by blessing a scalar reference to them.
+ foreach my $code_ref (@code_refs) {
+
+ if ( ref($code_ref) eq 'Try::Tiny::Catch' ) {
+ croak 'A try() may not be followed by multiple catch() blocks'
+ if $catch;
+ $catch = ${$code_ref};
+ } elsif ( ref($code_ref) eq 'Try::Tiny::Finally' ) {
+ push @finally, ${$code_ref};
+ } else {
+ croak(
+ 'try() encountered an unexpected argument ('
+ . ( defined $code_ref ? $code_ref : 'undef' )
+ . ') - perhaps a missing semi-colon before or'
+ );
+ }
+ }
+
+ # FIXME consider using local $SIG{__DIE__} to accumulate all errors. It's
+ # not perfect, but we could provide a list of additional errors for
+ # $catch->();
+
+ # name the blocks if we have Sub::Name installed
+ _subname(caller().'::try {...} ' => $try)
+ if _HAS_SUBNAME;
+
+ # set up scope guards to invoke the finally blocks at the end.
+ # this should really be a function scope lexical variable instead of
+ # file scope + local but that causes issues with perls < 5.20 due to
+ # perl rt#119311
+ local $_finally_guards{guards} = [
+ map { Try::Tiny::ScopeGuard->_new($_) }
+ @finally
+ ];
+
+ # save the value of $@ so we can set $@ back to it in the beginning of the eval
+ # and restore $@ after the eval finishes
+ my $prev_error = $@;
+
+ my ( @ret, $error );
+
+ # failed will be true if the eval dies, because 1 will not be returned
+ # from the eval body
+ my $failed = not eval {
+ $@ = $prev_error;
+
+ # evaluate the try block in the correct context
+ if ( $wantarray ) {
+ @ret = $try->();
+ } elsif ( defined $wantarray ) {
+ $ret[0] = $try->();
+ } else {
+ $try->();
+ };
+
+ return 1; # properly set $failed to false
+ };
+
+ # preserve the current error and reset the original value of $@
+ $error = $@;
+ $@ = $prev_error;
+
+ # at this point $failed contains a true value if the eval died, even if some
+ # destructor overwrote $@ as the eval was unwinding.
+ if ( $failed ) {
+ # pass $error to the finally blocks
+ push @$_, $error for @{$_finally_guards{guards}};
+
+ # if we got an error, invoke the catch block.
+ if ( $catch ) {
+ # This works like given($error), but is backwards compatible and
+ # sets $_ in the dynamic scope for the body of C<$catch>
+ for ($error) {
+ return $catch->($error);
+ }
+
+ # in case when() was used without an explicit return, the C<for>
+ # loop will be aborted and there's no useful return value
+ }
+
+ return;
+ } else {
+ # no failure, $@ is back to what it was, everything is fine
+ return $wantarray ? @ret : $ret[0];
+ }
+}
+
+sub catch (&;@) {
+ my ( $block, @rest ) = @_;
+
+ croak 'Useless bare catch()' unless wantarray;
+
+ _subname(caller().'::catch {...} ' => $block)
+ if _HAS_SUBNAME;
+ return (
+ bless(\$block, 'Try::Tiny::Catch'),
+ @rest,
+ );
+}
+
+sub finally (&;@) {
+ my ( $block, @rest ) = @_;
+
+ croak 'Useless bare finally()' unless wantarray;
+
+ _subname(caller().'::finally {...} ' => $block)
+ if _HAS_SUBNAME;
+ return (
+ bless(\$block, 'Try::Tiny::Finally'),
+ @rest,
+ );
+}
+
+{
+ package # hide from PAUSE
+ Try::Tiny::ScopeGuard;
+
+ use constant UNSTABLE_DOLLARAT => ("$]" < '5.013002') ? 1 : 0;
+
+ sub _new {
+ shift;
+ bless [ @_ ];
+ }
+
+ sub DESTROY {
+ my ($code, @args) = @{ $_[0] };
+
+ local $@ if UNSTABLE_DOLLARAT;
+ eval {
+ $code->(@args);
+ 1;
+ } or do {
+ warn
+ "Execution of finally() block $code resulted in an exception, which "
+ . '*CAN NOT BE PROPAGATED* due to fundamental limitations of Perl. '
+ . 'Your program will continue as if this event never took place. '
+ . "Original exception text follows:\n\n"
+ . (defined $@ ? $@ : '$@ left undefined...')
+ . "\n"
+ ;
+ }
+ }
+}
+
+__PACKAGE__
+
+__END__
+
+=pod
+
+=encoding UTF-8
+
+=head1 NAME
+
+Try::Tiny - Minimal try/catch with proper preservation of $@
+
+=head1 VERSION
+
+version 0.30
+
+=head1 SYNOPSIS
+
+You can use Try::Tiny's C<try> and C<catch> to expect and handle exceptional
+conditions, avoiding quirks in Perl and common mistakes:
+
+ # handle errors with a catch handler
+ try {
+ die "foo";
+ } catch {
+ warn "caught error: $_"; # not $@
+ };
+
+You can also use it like a standalone C<eval> to catch and ignore any error
+conditions. Obviously, this is an extreme measure not to be undertaken
+lightly:
+
+ # just silence errors
+ try {
+ die "foo";
+ };
+
+=head1 DESCRIPTION
+
+This module provides bare bones C<try>/C<catch>/C<finally> statements that are designed to
+minimize common mistakes with eval blocks, and NOTHING else.
+
+This is unlike L<TryCatch> which provides a nice syntax and avoids adding
+another call stack layer, and supports calling C<return> from the C<try> block to
+return from the parent subroutine. These extra features come at a cost of a few
+dependencies, namely L<Devel::Declare> and L<Scope::Upper> which are
+occasionally problematic, and the additional catch filtering uses L<Moose>
+type constraints which may not be desirable either.
+
+The main focus of this module is to provide simple and reliable error handling
+for those having a hard time installing L<TryCatch>, but who still want to
+write correct C<eval> blocks without 5 lines of boilerplate each time.
+
+It's designed to work as correctly as possible in light of the various
+pathological edge cases (see L</BACKGROUND>) and to be compatible with any style
+of error values (simple strings, references, objects, overloaded objects, etc).
+
+If the C<try> block dies, it returns the value of the last statement executed in
+the C<catch> block, if there is one. Otherwise, it returns C<undef> in scalar
+context or the empty list in list context. The following examples all
+assign C<"bar"> to C<$x>:
+
+ my $x = try { die "foo" } catch { "bar" };
+ my $x = try { die "foo" } || "bar";
+ my $x = (try { die "foo" }) // "bar";
+
+ my $x = eval { die "foo" } || "bar";
+
+You can add C<finally> blocks, yielding the following:
+
+ my $x;
+ try { die 'foo' } finally { $x = 'bar' };
+ try { die 'foo' } catch { warn "Got a die: $_" } finally { $x = 'bar' };
+
+C<finally> blocks are always executed making them suitable for cleanup code
+which cannot be handled using local. You can add as many C<finally> blocks to a
+given C<try> block as you like.
+
+Note that adding a C<finally> block without a preceding C<catch> block
+suppresses any errors. This behaviour is consistent with using a standalone
+C<eval>, but it is not consistent with C<try>/C<finally> patterns found in
+other programming languages, such as Java, Python, Javascript or C#. If you
+learnt the C<try>/C<finally> pattern from one of these languages, watch out for
+this.
+
+=head1 EXPORTS
+
+All functions are exported by default using L<Exporter>.
+
+If you need to rename the C<try>, C<catch> or C<finally> keyword consider using
+L<Sub::Import> to get L<Sub::Exporter>'s flexibility.
+
+=over 4
+
+=item try (&;@)
+
+Takes one mandatory C<try> subroutine, an optional C<catch> subroutine and C<finally>
+subroutine.
+
+The mandatory subroutine is evaluated in the context of an C<eval> block.
+
+If no error occurred the value from the first block is returned, preserving
+list/scalar context.
+
+If there was an error and the second subroutine was given it will be invoked
+with the error in C<$_> (localized) and as that block's first and only
+argument.
+
+C<$@> does B<not> contain the error. Inside the C<catch> block it has the same
+value it had before the C<try> block was executed.
+
+Note that the error may be false, but if that happens the C<catch> block will
+still be invoked.
+
+Once all execution is finished then the C<finally> block, if given, will execute.
+
+=item catch (&;@)
+
+Intended to be used in the second argument position of C<try>.
+
+Returns a reference to the subroutine it was given but blessed as
+C<Try::Tiny::Catch> which allows try to decode correctly what to do
+with this code reference.
+
+ catch { ... }
+
+Inside the C<catch> block the caught error is stored in C<$_>, while previous
+value of C<$@> is still available for use. This value may or may not be
+meaningful depending on what happened before the C<try>, but it might be a good
+idea to preserve it in an error stack.
+
+For code that captures C<$@> when throwing new errors (i.e.
+L<Class::Throwable>), you'll need to do:
+
+ local $@ = $_;
+
+=item finally (&;@)
+
+ try { ... }
+ catch { ... }
+ finally { ... };
+
+Or
+
+ try { ... }
+ finally { ... };
+
+Or even
+
+ try { ... }
+ finally { ... }
+ catch { ... };
+
+Intended to be the second or third element of C<try>. C<finally> blocks are always
+executed in the event of a successful C<try> or if C<catch> is run. This allows
+you to locate cleanup code which cannot be done via C<local()> e.g. closing a file
+handle.
+
+When invoked, the C<finally> block is passed the error that was caught. If no
+error was caught, it is passed nothing. (Note that the C<finally> block does not
+localize C<$_> with the error, since unlike in a C<catch> block, there is no way
+to know if C<$_ == undef> implies that there were no errors.) In other words,
+the following code does just what you would expect:
+
+ try {
+ die_sometimes();
+ } catch {
+ # ...code run in case of error
+ } finally {
+ if (@_) {
+ print "The try block died with: @_\n";
+ } else {
+ print "The try block ran without error.\n";
+ }
+ };
+
+B<You must always do your own error handling in the C<finally> block>. C<Try::Tiny> will
+not do anything about handling possible errors coming from code located in these
+blocks.
+
+Furthermore B<exceptions in C<finally> blocks are not trappable and are unable
+to influence the execution of your program>. This is due to limitation of
+C<DESTROY>-based scope guards, which C<finally> is implemented on top of. This
+may change in a future version of Try::Tiny.
+
+In the same way C<catch()> blesses the code reference this subroutine does the same
+except it bless them as C<Try::Tiny::Finally>.
+
+=back
+
+=head1 BACKGROUND
+
+There are a number of issues with C<eval>.
+
+=head2 Clobbering $@
+
+When you run an C<eval> block and it succeeds, C<$@> will be cleared, potentially
+clobbering an error that is currently being caught.
+
+This causes action at a distance, clearing previous errors your caller may have
+not yet handled.
+
+C<$@> must be properly localized before invoking C<eval> in order to avoid this
+issue.
+
+More specifically,
+L<before Perl version 5.14.0|perl5140delta/"Exception Handling">
+C<$@> was clobbered at the beginning of the C<eval>, which
+also made it impossible to capture the previous error before you die (for
+instance when making exception objects with error stacks).
+
+For this reason C<try> will actually set C<$@> to its previous value (the one
+available before entering the C<try> block) in the beginning of the C<eval>
+block.
+
+=head2 Localizing $@ silently masks errors
+
+Inside an C<eval> block, C<die> behaves sort of like:
+
+ sub die {
+ $@ = $_[0];
+ return_undef_from_eval();
+ }
+
+This means that if you were polite and localized C<$@> you can't die in that
+scope, or your error will be discarded (printing "Something's wrong" instead).
+
+The workaround is very ugly:
+
+ my $error = do {
+ local $@;
+ eval { ... };
+ $@;
+ };
+
+ ...
+ die $error;
+
+=head2 $@ might not be a true value
+
+This code is wrong:
+
+ if ( $@ ) {
+ ...
+ }
+
+because due to the previous caveats it may have been unset.
+
+C<$@> could also be an overloaded error object that evaluates to false, but
+that's asking for trouble anyway.
+
+The classic failure mode (fixed in L<Perl 5.14.0|perl5140delta/"Exception Handling">) is:
+
+ sub Object::DESTROY {
+ eval { ... }
+ }
+
+ eval {
+ my $obj = Object->new;
+
+ die "foo";
+ };
+
+ if ( $@ ) {
+
+ }
+
+In this case since C<Object::DESTROY> is not localizing C<$@> but still uses
+C<eval>, it will set C<$@> to C<"">.
+
+The destructor is called when the stack is unwound, after C<die> sets C<$@> to
+C<"foo at Foo.pm line 42\n">, so by the time C<if ( $@ )> is evaluated it has
+been cleared by C<eval> in the destructor.
+
+The workaround for this is even uglier than the previous ones. Even though we
+can't save the value of C<$@> from code that doesn't localize, we can at least
+be sure the C<eval> was aborted due to an error:
+
+ my $failed = not eval {
+ ...
+
+ return 1;
+ };
+
+This is because an C<eval> that caught a C<die> will always return a false
+value.
+
+=head1 ALTERNATE SYNTAX
+
+Using Perl 5.10 you can use L<perlsyn/"Switch statements"> (but please don't,
+because that syntax has since been deprecated because there was too much
+unexpected magical behaviour).
+
+=for stopwords topicalizer
+
+The C<catch> block is invoked in a topicalizer context (like a C<given> block),
+but note that you can't return a useful value from C<catch> using the C<when>
+blocks without an explicit C<return>.
+
+This is somewhat similar to Perl 6's C<CATCH> blocks. You can use it to
+concisely match errors:
+
+ try {
+ require Foo;
+ } catch {
+ when (/^Can't locate .*?\.pm in \@INC/) { } # ignore
+ default { die $_ }
+ };
+
+=head1 CAVEATS
+
+=over 4
+
+=item *
+
+C<@_> is not available within the C<try> block, so you need to copy your
+argument list. In case you want to work with argument values directly via C<@_>
+aliasing (i.e. allow C<$_[1] = "foo">), you need to pass C<@_> by reference:
+
+ sub foo {
+ my ( $self, @args ) = @_;
+ try { $self->bar(@args) }
+ }
+
+or
+
+ sub bar_in_place {
+ my $self = shift;
+ my $args = \@_;
+ try { $_ = $self->bar($_) for @$args }
+ }
+
+=item *
+
+C<return> returns from the C<try> block, not from the parent sub (note that
+this is also how C<eval> works, but not how L<TryCatch> works):
+
+ sub parent_sub {
+ try {
+ die;
+ }
+ catch {
+ return;
+ };
+
+ say "this text WILL be displayed, even though an exception is thrown";
+ }
+
+Instead, you should capture the return value:
+
+ sub parent_sub {
+ my $success = try {
+ die;
+ 1;
+ };
+ return unless $success;
+
+ say "This text WILL NEVER appear!";
+ }
+ # OR
+ sub parent_sub_with_catch {
+ my $success = try {
+ die;
+ 1;
+ }
+ catch {
+ # do something with $_
+ return undef; #see note
+ };
+ return unless $success;
+
+ say "This text WILL NEVER appear!";
+ }
+
+Note that if you have a C<catch> block, it must return C<undef> for this to work,
+since if a C<catch> block exists, its return value is returned in place of C<undef>
+when an exception is thrown.
+
+=item *
+
+C<try> introduces another caller stack frame. L<Sub::Uplevel> is not used. L<Carp>
+will not report this when using full stack traces, though, because
+C<%Carp::Internal> is used. This lack of magic is considered a feature.
+
+=for stopwords unhygienically
+
+=item *
+
+The value of C<$_> in the C<catch> block is not guaranteed to be the value of
+the exception thrown (C<$@>) in the C<try> block. There is no safe way to
+ensure this, since C<eval> may be used unhygienically in destructors. The only
+guarantee is that the C<catch> will be called if an exception is thrown.
+
+=item *
+
+The return value of the C<catch> block is not ignored, so if testing the result
+of the expression for truth on success, be sure to return a false value from
+the C<catch> block:
+
+ my $obj = try {
+ MightFail->new;
+ } catch {
+ ...
+
+ return; # avoid returning a true value;
+ };
+
+ return unless $obj;
+
+=item *
+
+C<$SIG{__DIE__}> is still in effect.
+
+Though it can be argued that C<$SIG{__DIE__}> should be disabled inside of
+C<eval> blocks, since it isn't people have grown to rely on it. Therefore in
+the interests of compatibility, C<try> does not disable C<$SIG{__DIE__}> for
+the scope of the error throwing code.
+
+=item *
+
+Lexical C<$_> may override the one set by C<catch>.
+
+For example Perl 5.10's C<given> form uses a lexical C<$_>, creating some
+confusing behavior:
+
+ given ($foo) {
+ when (...) {
+ try {
+ ...
+ } catch {
+ warn $_; # will print $foo, not the error
+ warn $_[0]; # instead, get the error like this
+ }
+ }
+ }
+
+Note that this behavior was changed once again in
+L<Perl5 version 18|https://metacpan.org/module/perldelta#given-now-aliases-the-global-_>.
+However, since the entirety of lexical C<$_> is now L<considered experimental
+|https://metacpan.org/module/perldelta#Lexical-_-is-now-experimental>, it
+is unclear whether the new version 18 behavior is final.
+
+=back
+
+=head1 SEE ALSO
+
+=over 4
+
+=item L<TryCatch>
+
+Much more feature complete, more convenient semantics, but at the cost of
+implementation complexity.
+
+=item L<autodie>
+
+Automatic error throwing for builtin functions and more. Also designed to
+work well with C<given>/C<when>.
+
+=item L<Throwable>
+
+A lightweight role for rolling your own exception classes.
+
+=item L<Error>
+
+Exception object implementation with a C<try> statement. Does not localize
+C<$@>.
+
+=item L<Exception::Class::TryCatch>
+
+Provides a C<catch> statement, but properly calling C<eval> is your
+responsibility.
+
+The C<try> keyword pushes C<$@> onto an error stack, avoiding some of the
+issues with C<$@>, but you still need to localize to prevent clobbering.
+
+=back
+
+=head1 LIGHTNING TALK
+
+I gave a lightning talk about this module, you can see the slides (Firefox
+only):
+
+L<http://web.archive.org/web/20100628040134/http://nothingmuch.woobling.org/talks/takahashi.xul>
+
+Or read the source:
+
+L<http://web.archive.org/web/20100305133605/http://nothingmuch.woobling.org/talks/yapc_asia_2009/try_tiny.yml>
+
+=head1 SUPPORT
+
+Bugs may be submitted through L<the RT bug tracker|https://rt.cpan.org/Public/Dist/Display.html?Name=Try-Tiny>
+(or L<bug-Try-Tiny@rt.cpan.org|mailto:bug-Try-Tiny@rt.cpan.org>).
+
+=head1 AUTHORS
+
+=over 4
+
+=item *
+
+יובל קוג'מן (Yuval Kogman) <nothingmuch@woobling.org>
+
+=item *
+
+Jesse Luehrs <doy@tozt.net>
+
+=back
+
+=head1 CONTRIBUTORS
+
+=for stopwords Karen Etheridge Peter Rabbitson Ricardo Signes Mark Fowler Graham Knop Lukas Mai Aristotle Pagaltzis Dagfinn Ilmari Mannsåker Paul Howarth Rudolf Leermakers anaxagoras awalker chromatic Alex cm-perl Andrew Yates David Lowe Glenn Hans Dieter Pearcey Jens Berthold Jonathan Yu Marc Mims Stosberg Pali
+
+=over 4
+
+=item *
+
+Karen Etheridge <ether@cpan.org>
+
+=item *
+
+Peter Rabbitson <ribasushi@cpan.org>
+
+=item *
+
+Ricardo Signes <rjbs@cpan.org>
+
+=item *
+
+Mark Fowler <mark@twoshortplanks.com>
+
+=item *
+
+Graham Knop <haarg@haarg.org>
+
+=item *
+
+Lukas Mai <l.mai@web.de>
+
+=item *
+
+Aristotle Pagaltzis <pagaltzis@gmx.de>
+
+=item *
+
+Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
+
+=item *
+
+Paul Howarth <paul@city-fan.org>
+
+=item *
+
+Rudolf Leermakers <rudolf@hatsuseno.org>
+
+=item *
+
+anaxagoras <walkeraj@gmail.com>
+
+=item *
+
+awalker <awalker@sourcefire.com>
+
+=item *
+
+chromatic <chromatic@wgz.org>
+
+=item *
+
+Alex <alex@koban.(none)>
+
+=item *
+
+cm-perl <cm-perl@users.noreply.github.com>
+
+=item *
+
+Andrew Yates <ayates@haddock.local>
+
+=item *
+
+David Lowe <davidl@lokku.com>
+
+=item *
+
+Glenn Fowler <cebjyre@cpan.org>
+
+=item *
+
+Hans Dieter Pearcey <hdp@weftsoar.net>
+
+=item *
+
+Jens Berthold <jens@jebecs.de>
+
+=item *
+
+Jonathan Yu <JAWNSY@cpan.org>
+
+=item *
+
+Marc Mims <marc@questright.com>
+
+=item *
+
+Mark Stosberg <mark@stosberg.com>
+
+=item *
+
+Pali <pali@cpan.org>
+
+=back
+
+=head1 COPYRIGHT AND LICENCE
+
+This software is Copyright (c) 2009 by יובל קוג'מן (Yuval Kogman).
+
+This is free software, licensed under:
+
+ The MIT (X11) License
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm
new file mode 100644
index 0000000000..7d259c734a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI.pm
@@ -0,0 +1,1162 @@
+package URI;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+our ($ABS_REMOTE_LEADING_DOTS, $ABS_ALLOW_RELATIVE_SCHEME, $DEFAULT_QUERY_FORM_DELIMITER);
+
+my %implements; # mapping from scheme to implementor class
+
+# Some "official" character classes
+
+our $reserved = q(;/?:@&=+$,[]);
+our $mark = q(-_.!~*'()); #'; emacs
+our $unreserved = "A-Za-z0-9\Q$mark\E";
+our $uric = quotemeta($reserved) . $unreserved . "%";
+
+our $scheme_re = '[a-zA-Z][a-zA-Z0-9.+\-]*';
+
+use Carp ();
+use URI::Escape ();
+
+use overload ('""' => sub { ${$_[0]} },
+ '==' => sub { _obj_eq(@_) },
+ '!=' => sub { !_obj_eq(@_) },
+ fallback => 1,
+ );
+
+# Check if two objects are the same object
+sub _obj_eq {
+ return overload::StrVal($_[0]) eq overload::StrVal($_[1]);
+}
+
+sub new
+{
+ my($class, $uri, $scheme) = @_;
+
+ $uri = defined ($uri) ? "$uri" : ""; # stringify
+ # Get rid of potential wrapping
+ $uri =~ s/^<(?:URL:)?(.*)>$/$1/; #
+ $uri =~ s/^"(.*)"$/$1/;
+ $uri =~ s/^\s+//;
+ $uri =~ s/\s+$//;
+
+ my $impclass;
+ if ($uri =~ m/^($scheme_re):/so) {
+ $scheme = $1;
+ }
+ else {
+ if (($impclass = ref($scheme))) {
+ $scheme = $scheme->scheme;
+ }
+ elsif ($scheme && $scheme =~ m/^($scheme_re)(?::|$)/o) {
+ $scheme = $1;
+ }
+ }
+ $impclass ||= implementor($scheme) ||
+ do {
+ require URI::_foreign;
+ $impclass = 'URI::_foreign';
+ };
+
+ return $impclass->_init($uri, $scheme);
+}
+
+
+sub new_abs
+{
+ my($class, $uri, $base) = @_;
+ $uri = $class->new($uri, $base);
+ $uri->abs($base);
+}
+
+
+sub _init
+{
+ my $class = shift;
+ my($str, $scheme) = @_;
+ # find all funny characters and encode the bytes.
+ $str = $class->_uric_escape($str);
+ $str = "$scheme:$str" unless $str =~ /^$scheme_re:/o ||
+ $class->_no_scheme_ok;
+ my $self = bless \$str, $class;
+ $self;
+}
+
+
+sub _uric_escape
+{
+ my($class, $str) = @_;
+ $str =~ s*([^$uric\#])* URI::Escape::escape_char($1) *ego;
+ utf8::downgrade($str);
+ return $str;
+}
+
+my %require_attempted;
+
+sub implementor
+{
+ my($scheme, $impclass) = @_;
+ if (!$scheme || $scheme !~ /\A$scheme_re\z/o) {
+ require URI::_generic;
+ return "URI::_generic";
+ }
+
+ $scheme = lc($scheme);
+
+ if ($impclass) {
+ # Set the implementor class for a given scheme
+ my $old = $implements{$scheme};
+ $impclass->_init_implementor($scheme);
+ $implements{$scheme} = $impclass;
+ return $old;
+ }
+
+ my $ic = $implements{$scheme};
+ return $ic if $ic;
+
+ # scheme not yet known, look for internal or
+ # preloaded (with 'use') implementation
+ $ic = "URI::$scheme"; # default location
+
+ # turn scheme into a valid perl identifier by a simple transformation...
+ $ic =~ s/\+/_P/g;
+ $ic =~ s/\./_O/g;
+ $ic =~ s/\-/_/g;
+
+ no strict 'refs';
+ # check we actually have one for the scheme:
+ unless (@{"${ic}::ISA"}) {
+ if (not exists $require_attempted{$ic}) {
+ # Try to load it
+ my $_old_error = $@;
+ eval "require $ic";
+ die $@ if $@ && $@ !~ /Can\'t locate.*in \@INC/;
+ $@ = $_old_error;
+ }
+ return undef unless @{"${ic}::ISA"};
+ }
+
+ $ic->_init_implementor($scheme);
+ $implements{$scheme} = $ic;
+ $ic;
+}
+
+
+sub _init_implementor
+{
+ my($class, $scheme) = @_;
+ # Remember that one implementor class may actually
+ # serve to implement several URI schemes.
+}
+
+
+sub clone
+{
+ my $self = shift;
+ my $other = $$self;
+ bless \$other, ref $self;
+}
+
+sub TO_JSON { ${$_[0]} }
+
+sub _no_scheme_ok { 0 }
+
+sub _scheme
+{
+ my $self = shift;
+
+ unless (@_) {
+ return undef unless $$self =~ /^($scheme_re):/o;
+ return $1;
+ }
+
+ my $old;
+ my $new = shift;
+ if (defined($new) && length($new)) {
+ 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;
+ bless $self, ref($newself);
+ }
+ else {
+ if ($self->_no_scheme_ok) {
+ $old = $1 if $$self =~ s/^($scheme_re)://o;
+ Carp::carp("Oops, opaque part now look like scheme")
+ if $^W && $$self =~ m/^$scheme_re:/o
+ }
+ else {
+ $old = $1 if $$self =~ m/^($scheme_re):/o;
+ }
+ }
+
+ return $old;
+}
+
+sub scheme
+{
+ my $scheme = shift->_scheme(@_);
+ return undef unless defined $scheme;
+ lc($scheme);
+}
+
+sub has_recognized_scheme {
+ my $self = shift;
+ return ref($self) !~ /^URI::_(?:foreign|generic)\z/;
+}
+
+sub opaque
+{
+ my $self = shift;
+
+ unless (@_) {
+ $$self =~ /^(?:$scheme_re:)?([^\#]*)/o or die;
+ return $1;
+ }
+
+ $$self =~ /^($scheme_re:)? # optional scheme
+ ([^\#]*) # opaque
+ (\#.*)? # optional fragment
+ $/sx or die;
+
+ my $old_scheme = $1;
+ my $old_opaque = $2;
+ my $old_frag = $3;
+
+ my $new_opaque = shift;
+ $new_opaque = "" unless defined $new_opaque;
+ $new_opaque =~ s/([^$uric])/ URI::Escape::escape_char($1)/ego;
+ utf8::downgrade($new_opaque);
+
+ $$self = defined($old_scheme) ? $old_scheme : "";
+ $$self .= $new_opaque;
+ $$self .= $old_frag if defined $old_frag;
+
+ $old_opaque;
+}
+
+sub path { goto &opaque } # alias
+
+
+sub fragment
+{
+ my $self = shift;
+ unless (@_) {
+ return undef unless $$self =~ /\#(.*)/s;
+ return $1;
+ }
+
+ my $old;
+ $old = $1 if $$self =~ s/\#(.*)//s;
+
+ my $new_frag = shift;
+ if (defined $new_frag) {
+ $new_frag =~ s/([^$uric])/ URI::Escape::escape_char($1) /ego;
+ utf8::downgrade($new_frag);
+ $$self .= "#$new_frag";
+ }
+ $old;
+}
+
+
+sub as_string
+{
+ my $self = shift;
+ $$self;
+}
+
+
+sub as_iri
+{
+ my $self = shift;
+ my $str = $$self;
+ if ($str =~ s/%([89a-fA-F][0-9a-fA-F])/chr(hex($1))/eg) {
+ # All this crap because the more obvious:
+ #
+ # Encode::decode("UTF-8", $str, sub { sprintf "%%%02X", shift })
+ #
+ # doesn't work before Encode 2.39. Wait for a standard release
+ # to bundle that version.
+
+ require Encode;
+ my $enc = Encode::find_encoding("UTF-8");
+ my $u = "";
+ while (length $str) {
+ $u .= $enc->decode($str, Encode::FB_QUIET());
+ if (length $str) {
+ # escape next char
+ $u .= URI::Escape::escape_char(substr($str, 0, 1, ""));
+ }
+ }
+ $str = $u;
+ }
+ return $str;
+}
+
+
+sub canonical
+{
+ # Make sure scheme is lowercased, that we don't escape unreserved chars,
+ # and that we use upcase escape sequences.
+
+ my $self = shift;
+ my $scheme = $self->_scheme || "";
+ my $uc_scheme = $scheme =~ /[A-Z]/;
+ my $esc = $$self =~ /%[a-fA-F0-9]{2}/;
+ return $self unless $uc_scheme || $esc;
+
+ my $other = $self->clone;
+ if ($uc_scheme) {
+ $other->_scheme(lc $scheme);
+ }
+ if ($esc) {
+ $$other =~ s{%([0-9a-fA-F]{2})}
+ { my $a = chr(hex($1));
+ $a =~ /^[$unreserved]\z/o ? $a : "%\U$1"
+ }ge;
+ }
+ return $other;
+}
+
+# Compare two URIs, subclasses will provide a more correct implementation
+sub eq {
+ my($self, $other) = @_;
+ $self = URI->new($self, $other) unless ref $self;
+ $other = URI->new($other, $self) unless ref $other;
+ ref($self) eq ref($other) && # same class
+ $self->canonical->as_string eq $other->canonical->as_string;
+}
+
+# generic-URI transformation methods
+sub abs { $_[0]; }
+sub rel { $_[0]; }
+
+sub secure { 0 }
+
+# help out Storable
+sub STORABLE_freeze {
+ my($self, $cloning) = @_;
+ return $$self;
+}
+
+sub STORABLE_thaw {
+ my($self, $cloning, $str) = @_;
+ $$self = $str;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+URI - Uniform Resource Identifiers (absolute and relative)
+
+=head1 SYNOPSIS
+
+ use URI;
+
+ $u1 = URI->new("http://www.perl.com");
+ $u2 = URI->new("foo", "http");
+ $u3 = $u2->abs($u1);
+ $u4 = $u3->clone;
+ $u5 = URI->new("HTTP://WWW.perl.com:80")->canonical;
+
+ $str = $u->as_string;
+ $str = "$u";
+
+ $scheme = $u->scheme;
+ $opaque = $u->opaque;
+ $path = $u->path;
+ $frag = $u->fragment;
+
+ $u->scheme("ftp");
+ $u->host("ftp.perl.com");
+ $u->path("cpan/");
+
+=head1 DESCRIPTION
+
+This module implements the C<URI> class. Objects of this class
+represent "Uniform Resource Identifier references" as specified in RFC
+2396 (and updated by RFC 2732).
+
+A Uniform Resource Identifier is a compact string of characters that
+identifies an abstract or physical resource. A Uniform Resource
+Identifier can be further classified as either a Uniform Resource Locator
+(URL) or a Uniform Resource Name (URN). The distinction between URL
+and URN does not matter to the C<URI> class interface. A
+"URI-reference" is a URI that may have additional information attached
+in the form of a fragment identifier.
+
+An absolute URI reference consists of three parts: a I<scheme>, a
+I<scheme-specific part> and a I<fragment> identifier. A subset of URI
+references share a common syntax for hierarchical namespaces. For
+these, the scheme-specific part is further broken down into
+I<authority>, I<path> and I<query> components. These URIs can also
+take the form of relative URI references, where the scheme (and
+usually also the authority) component is missing, but implied by the
+context of the URI reference. The three forms of URI reference
+syntax are summarized as follows:
+
+ <scheme>:<scheme-specific-part>#<fragment>
+ <scheme>://<authority><path>?<query>#<fragment>
+ <path>?<query>#<fragment>
+
+The components into which a URI reference can be divided depend on the
+I<scheme>. The C<URI> class provides methods to get and set the
+individual components. The methods available for a specific
+C<URI> object depend on the scheme.
+
+=head1 CONSTRUCTORS
+
+The following methods construct new C<URI> objects:
+
+=over 4
+
+=item $uri = URI->new( $str )
+
+=item $uri = URI->new( $str, $scheme )
+
+Constructs a new URI object. The string
+representation of a URI is given as argument, together with an optional
+scheme specification. Common URI wrappers like "" and <>, as well as
+leading and trailing white space, are automatically removed from
+the $str argument before it is processed further.
+
+The constructor determines the scheme, maps this to an appropriate
+URI subclass, constructs a new object of that class and returns it.
+
+If the scheme isn't one of those that URI recognizes, you still get
+an URI object back that you can access the generic methods on. The
+C<< $uri->has_recognized_scheme >> method can be used to test for
+this.
+
+The $scheme argument is only used when $str is a
+relative URI. It can be either a simple string that
+denotes the scheme, a string containing an absolute URI reference, or
+an absolute C<URI> object. If no $scheme is specified for a relative
+URI $str, then $str is simply treated as a generic URI (no scheme-specific
+methods available).
+
+The set of characters available for building URI references is
+restricted (see L<URI::Escape>). Characters outside this set are
+automatically escaped by the URI constructor.
+
+=item $uri = URI->new_abs( $str, $base_uri )
+
+Constructs a new absolute URI object. The $str argument can
+denote a relative or absolute URI. If relative, then it is
+absolutized using $base_uri as base. The $base_uri must be an absolute
+URI.
+
+=item $uri = URI::file->new( $filename )
+
+=item $uri = URI::file->new( $filename, $os )
+
+Constructs a new I<file> URI from a file name. See L<URI::file>.
+
+=item $uri = URI::file->new_abs( $filename )
+
+=item $uri = URI::file->new_abs( $filename, $os )
+
+Constructs a new absolute I<file> URI from a file name. See
+L<URI::file>.
+
+=item $uri = URI::file->cwd
+
+Returns the current working directory as a I<file> URI. See
+L<URI::file>.
+
+=item $uri->clone
+
+Returns a copy of the $uri.
+
+=back
+
+=head1 COMMON METHODS
+
+The methods described in this section are available for all C<URI>
+objects.
+
+Methods that give access to components of a URI always return the
+old value of the component. The value returned is C<undef> if the
+component was not present. There is generally a difference between a
+component that is empty (represented as C<"">) and a component that is
+missing (represented as C<undef>). If an accessor method is given an
+argument, it updates the corresponding component in addition to
+returning the old value of the component. Passing an undefined
+argument removes the component (if possible). The description of
+each accessor method indicates whether the component is passed as
+an escaped (percent-encoded) or an unescaped string. A component that can be further
+divided into sub-parts are usually passed escaped, as unescaping might
+change its semantics.
+
+The common methods available for all URI are:
+
+=over 4
+
+=item $uri->scheme
+
+=item $uri->scheme( $new_scheme )
+
+Sets and returns the scheme part of the $uri. If the $uri is
+relative, then $uri->scheme returns C<undef>. If called with an
+argument, it updates the scheme of $uri, possibly changing the
+class of $uri, and returns the old scheme value. The method croaks
+if the new scheme name is illegal; a scheme name must begin with a
+letter and must consist of only US-ASCII letters, numbers, and a few
+special marks: ".", "+", "-". This restriction effectively means
+that the scheme must be passed unescaped. Passing an undefined
+argument to the scheme method makes the URI relative (if possible).
+
+Letter case does not matter for scheme names. The string
+returned by $uri->scheme is always lowercase. If you want the scheme
+just as it was written in the URI in its original case,
+you can use the $uri->_scheme method instead.
+
+=item $uri->has_recognized_scheme
+
+Returns TRUE if the URI scheme is one that URI recognizes.
+
+It will also be TRUE for relative URLs where a recognized
+scheme was provided to the constructor, even if C<< $uri->scheme >>
+returns C<undef> for these.
+
+=item $uri->opaque
+
+=item $uri->opaque( $new_opaque )
+
+Sets and returns the scheme-specific part of the $uri
+(everything between the scheme and the fragment)
+as an escaped string.
+
+=item $uri->path
+
+=item $uri->path( $new_path )
+
+Sets and returns the same value as $uri->opaque unless the URI
+supports the generic syntax for hierarchical namespaces.
+In that case the generic method is overridden to set and return
+the part of the URI between the I<host name> and the I<fragment>.
+
+=item $uri->fragment
+
+=item $uri->fragment( $new_frag )
+
+Returns the fragment identifier of a URI reference
+as an escaped string.
+
+=item $uri->as_string
+
+Returns a URI object to a plain ASCII string. URI objects are
+also converted to plain strings automatically by overloading. This
+means that $uri objects can be used as plain strings in most Perl
+constructs.
+
+=item $uri->as_iri
+
+Returns a Unicode string representing the URI. Escaped UTF-8 sequences
+representing non-ASCII characters are turned into their corresponding Unicode
+code point.
+
+=item $uri->canonical
+
+Returns a normalized version of the URI. The rules
+for normalization are scheme-dependent. They usually involve
+lowercasing the scheme and Internet host name components,
+removing the explicit port specification if it matches the default port,
+uppercasing all escape sequences, and unescaping octets that can be
+better represented as plain characters.
+
+For efficiency reasons, if the $uri is already in normalized form,
+then a reference to it is returned instead of a copy.
+
+=item $uri->eq( $other_uri )
+
+=item URI::eq( $first_uri, $other_uri )
+
+Tests whether two URI references are equal. URI references
+that normalize to the same string are considered equal. The method
+can also be used as a plain function which can also test two string
+arguments.
+
+If you need to test whether two C<URI> object references denote the
+same object, use the '==' operator.
+
+=item $uri->abs( $base_uri )
+
+Returns an absolute URI reference. If $uri is already
+absolute, then a reference to it is simply returned. If the $uri
+is relative, then a new absolute URI is constructed by combining the
+$uri and the $base_uri, and returned.
+
+=item $uri->rel( $base_uri )
+
+Returns a relative URI reference if it is possible to
+make one that denotes the same resource relative to $base_uri.
+If not, then $uri is simply returned.
+
+=item $uri->secure
+
+Returns a TRUE value if the URI is considered to point to a resource on
+a secure channel, such as an SSL or TLS encrypted one.
+
+=back
+
+=head1 GENERIC METHODS
+
+The following methods are available to schemes that use the
+common/generic syntax for hierarchical namespaces. The descriptions of
+schemes below indicate which these are. Unrecognized schemes are
+assumed to support the generic syntax, and therefore the following
+methods:
+
+=over 4
+
+=item $uri->authority
+
+=item $uri->authority( $new_authority )
+
+Sets and returns the escaped authority component
+of the $uri.
+
+=item $uri->path
+
+=item $uri->path( $new_path )
+
+Sets and returns the escaped path component of
+the $uri (the part between the host name and the query or fragment).
+The path can never be undefined, but it can be the empty string.
+
+=item $uri->path_query
+
+=item $uri->path_query( $new_path_query )
+
+Sets and returns the escaped path and query
+components as a single entity. The path and the query are
+separated by a "?" character, but the query can itself contain "?".
+
+=item $uri->path_segments
+
+=item $uri->path_segments( $segment, ... )
+
+Sets and returns the path. In a scalar context, it returns
+the same value as $uri->path. In a list context, it returns the
+unescaped path segments that make up the path. Path segments that
+have parameters are returned as an anonymous array. The first element
+is the unescaped path segment proper; subsequent elements are escaped
+parameter strings. Such an anonymous array uses overloading so it can
+be treated as a string too, but this string does not include the
+parameters.
+
+Note that absolute paths have the empty string as their first
+I<path_segment>, i.e. the I<path> C</foo/bar> have 3
+I<path_segments>; "", "foo" and "bar".
+
+=item $uri->query
+
+=item $uri->query( $new_query )
+
+Sets and returns the escaped query component of
+the $uri.
+
+=item $uri->query_form
+
+=item $uri->query_form( $key1 => $val1, $key2 => $val2, ... )
+
+=item $uri->query_form( $key1 => $val1, $key2 => $val2, ..., $delim )
+
+=item $uri->query_form( \@key_value_pairs )
+
+=item $uri->query_form( \@key_value_pairs, $delim )
+
+=item $uri->query_form( \%hash )
+
+=item $uri->query_form( \%hash, $delim )
+
+Sets and returns query components that use the
+I<application/x-www-form-urlencoded> format. Key/value pairs are
+separated by "&", and the key is separated from the value by a "="
+character.
+
+The form can be set either by passing separate key/value pairs, or via
+an array or hash reference. Passing an empty array or an empty hash
+removes the query component, whereas passing no arguments at all leaves
+the component unchanged. The order of keys is undefined if a hash
+reference is passed. The old value is always returned as a list of
+separate key/value pairs. Assigning this list to a hash is unwise as
+the keys returned might repeat.
+
+The values passed when setting the form can be plain strings or
+references to arrays of strings. Passing an array of values has the
+same effect as passing the key repeatedly with one value at a time.
+All the following statements have the same effect:
+
+ $uri->query_form(foo => 1, foo => 2);
+ $uri->query_form(foo => [1, 2]);
+ $uri->query_form([ foo => 1, foo => 2 ]);
+ $uri->query_form([ foo => [1, 2] ]);
+ $uri->query_form({ foo => [1, 2] });
+
+The $delim parameter can be passed as ";" to force the key/value pairs
+to be delimited by ";" instead of "&" in the query string. This
+practice is often recommended for URLs embedded in HTML or XML
+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 $uri->query_keywords
+
+=item $uri->query_keywords( $keywords, ... )
+
+=item $uri->query_keywords( \@keywords )
+
+Sets and returns query components that use the
+keywords separated by "+" format.
+
+The keywords can be set either by passing separate keywords directly
+or by passing a reference to an array of keywords. Passing an empty
+array removes the query component, whereas passing no arguments at
+all leaves the component unchanged. The old value is always returned
+as a list of separate words.
+
+=back
+
+=head1 SERVER METHODS
+
+For schemes where the I<authority> component denotes an Internet host,
+the following methods are available in addition to the generic
+methods.
+
+=over 4
+
+=item $uri->userinfo
+
+=item $uri->userinfo( $new_userinfo )
+
+Sets and returns the escaped userinfo part of the
+authority component.
+
+For some schemes this is a user name and a password separated by
+a colon. This practice is not recommended. Embedding passwords in
+clear text (such as URI) has proven to be a security risk in almost
+every case where it has been used.
+
+=item $uri->host
+
+=item $uri->host( $new_host )
+
+Sets and returns the unescaped hostname.
+
+If the $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
+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.
+
+=item $uri->ihost
+
+Returns the host in Unicode form. Any IDNA A-labels are turned into U-labels.
+
+=item $uri->port
+
+=item $uri->port( $new_port )
+
+Sets and returns the port. The port is a simple integer
+that should be greater than 0.
+
+If a port is not specified explicitly in the URI, then the URI scheme's default port
+is returned. If you don't want the default port
+substituted, then you can use the $uri->_port method instead.
+
+=item $uri->host_port
+
+=item $uri->host_port( $new_host_port )
+
+Sets and returns the host and port as a single
+unit. The returned value includes a port, even if it matches the
+default port. The host part and the port part are separated by a
+colon: ":".
+
+For IPv6 addresses the bracketing is preserved; thus
+URI->new("http://[::1]/")->host_port returns "[::1]:80". Contrast this with
+$uri->host which will remove the brackets.
+
+=item $uri->default_port
+
+Returns the default port of the URI scheme to which $uri
+belongs. For I<http> this is the number 80, for I<ftp> this
+is the number 21, etc. The default port for a scheme can not be
+changed.
+
+=back
+
+=head1 SCHEME-SPECIFIC SUPPORT
+
+Scheme-specific support is provided for the following URI schemes. For C<URI>
+objects that do not belong to one of these, you can only use the common and
+generic methods.
+
+=over 4
+
+=item B<data>:
+
+The I<data> URI scheme is specified in RFC 2397. It allows inclusion
+of small data items as "immediate" data, as if it had been included
+externally.
+
+C<URI> objects belonging to the data scheme support the common methods
+and two new methods to access their scheme-specific components:
+$uri->media_type and $uri->data. See L<URI::data> for details.
+
+=item B<file>:
+
+An old specification of the I<file> URI scheme is found in RFC 1738.
+A new RFC 2396 based specification in not available yet, but file URI
+references are in common use.
+
+C<URI> objects belonging to the file scheme support the common and
+generic methods. In addition, they provide two methods for mapping file URIs
+back to local file names; $uri->file and $uri->dir. See L<URI::file>
+for details.
+
+=item B<ftp>:
+
+An old specification of the I<ftp> URI scheme is found in RFC 1738. A
+new RFC 2396 based specification in not available yet, but ftp URI
+references are in common use.
+
+C<URI> objects belonging to the ftp scheme support the common,
+generic and server methods. In addition, they provide two methods for
+accessing the userinfo sub-components: $uri->user and $uri->password.
+
+=item B<gopher>:
+
+The I<gopher> URI scheme is specified in
+<draft-murali-url-gopher-1996-12-04> and will hopefully be available
+as a RFC 2396 based specification.
+
+C<URI> objects belonging to the gopher scheme support the common,
+generic and server methods. In addition, they support some methods for
+accessing gopher-specific path components: $uri->gopher_type,
+$uri->selector, $uri->search, $uri->string.
+
+=item B<http>:
+
+The I<http> URI scheme is specified in RFC 2616.
+The scheme is used to reference resources hosted by HTTP servers.
+
+C<URI> objects belonging to the http scheme support the common,
+generic and server methods.
+
+=item B<https>:
+
+The I<https> URI scheme is a Netscape invention which is commonly
+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<ldap>:
+
+The I<ldap> URI scheme is specified in RFC 2255. LDAP is the
+Lightweight Directory Access Protocol. An ldap URI describes an LDAP
+search operation to perform to retrieve information from an LDAP
+directory.
+
+C<URI> objects belonging to the ldap scheme support the common,
+generic and server methods as well as ldap-specific methods: $uri->dn,
+$uri->attributes, $uri->scope, $uri->filter, $uri->extensions. See
+L<URI::ldap> for details.
+
+=item B<ldapi>:
+
+Like the I<ldap> URI scheme, but uses a UNIX domain socket. The
+server methods are not supported, and the local socket path is
+available as $uri->un_path. The I<ldapi> scheme is used by the
+OpenLDAP package. There is no real specification for it, but it is
+mentioned in various OpenLDAP manual pages.
+
+=item B<ldaps>:
+
+Like the I<ldap> URI scheme, but uses an SSL connection. This
+scheme is deprecated, as the preferred way is to use the I<start_tls>
+mechanism.
+
+=item B<mailto>:
+
+The I<mailto> URI scheme is specified in RFC 2368. The scheme was
+originally used to designate the Internet mailing address of an
+individual or service. It has (in RFC 2368) been extended to allow
+setting of other mail header fields and the message body.
+
+C<URI> objects belonging to the mailto scheme support the common
+methods and the generic query methods. In addition, they support the
+following mailto-specific methods: $uri->to, $uri->headers.
+
+Note that the "foo@example.com" part of a mailto is I<not> the
+C<userinfo> and C<host> but instead the C<path>. This allows a
+mailto URI to contain multiple comma separated email addresses.
+
+=item B<mms>:
+
+The I<mms> URL specification can be found at L<http://sdp.ppona.com/>.
+C<URI> objects belonging to the mms scheme support the common,
+generic, and server methods, with the exception of userinfo and
+query-related sub-components.
+
+=item B<news>:
+
+The I<news>, I<nntp> and I<snews> URI schemes are specified in
+<draft-gilman-news-url-01> and will hopefully be available as an RFC
+2396 based specification soon.
+
+C<URI> objects belonging to the news scheme support the common,
+generic and server methods. In addition, they provide some methods to
+access the path: $uri->group and $uri->message.
+
+=item B<nntp>:
+
+See I<news> scheme.
+
+=item B<pop>:
+
+The I<pop> URI scheme is specified in RFC 2384. The scheme is used to
+reference a POP3 mailbox.
+
+C<URI> objects belonging to the pop scheme support the common, generic
+and server methods. In addition, they provide two methods to access the
+userinfo components: $uri->user and $uri->auth
+
+=item B<rlogin>:
+
+An old specification of the I<rlogin> URI scheme is found in RFC
+1738. C<URI> objects belonging to the rlogin scheme support the
+common, generic and server methods.
+
+=item B<rtsp>:
+
+The I<rtsp> URL specification can be found in section 3.2 of RFC 2326.
+C<URI> objects belonging to the rtsp scheme support the common,
+generic, and server methods, with the exception of userinfo and
+query-related sub-components.
+
+=item B<rtspu>:
+
+The I<rtspu> URI scheme is used to talk to RTSP servers over UDP
+instead of TCP. The syntax is the same as rtsp.
+
+=item B<rsync>:
+
+Information about rsync is available from L<http://rsync.samba.org/>.
+C<URI> objects belonging to the rsync scheme support the common,
+generic and server methods. In addition, they provide methods to
+access the userinfo sub-components: $uri->user and $uri->password.
+
+=item B<sip>:
+
+The I<sip> URI specification is described in sections 19.1 and 25
+of RFC 3261. C<URI> objects belonging to the sip scheme support the
+common, generic, and server methods with the exception of path related
+sub-components. In addition, they provide two methods to get and set
+I<sip> parameters: $uri->params_form and $uri->params.
+
+=item B<sips>:
+
+See I<sip> scheme. Its syntax is the same as sip, but the default
+port is different.
+
+=item B<snews>:
+
+See I<news> scheme. Its syntax is the same as news, but the default
+port is different.
+
+=item B<telnet>:
+
+An old specification of the I<telnet> URI scheme is found in RFC
+1738. C<URI> objects belonging to the telnet scheme support the
+common, generic and server methods.
+
+=item B<tn3270>:
+
+These URIs are used like I<telnet> URIs but for connections to IBM
+mainframes. C<URI> objects belonging to the tn3270 scheme support the
+common, generic and server methods.
+
+=item B<ssh>:
+
+Information about ssh is available at L<http://www.openssh.com/>.
+C<URI> objects belonging to the ssh scheme support the common,
+generic and server methods. In addition, they provide methods to
+access the userinfo sub-components: $uri->user and $uri->password.
+
+=item B<sftp>:
+
+C<URI> objects belonging to the sftp scheme support the common,
+generic and server methods. In addition, they provide methods to
+access the userinfo sub-components: $uri->user and $uri->password.
+
+=item B<urn>:
+
+The syntax of Uniform Resource Names is specified in RFC 2141. C<URI>
+objects belonging to the urn scheme provide the common methods, and also the
+methods $uri->nid and $uri->nss, which return the Namespace Identifier
+and the Namespace-Specific String respectively.
+
+The Namespace Identifier basically works like the Scheme identifier of
+URIs, and further divides the URN namespace. Namespace Identifier
+assignments are maintained at
+L<http://www.iana.org/assignments/urn-namespaces>.
+
+Letter case is not significant for the Namespace Identifier. It is
+always returned in lower case by the $uri->nid method. The $uri->_nid
+method can be used if you want it in its original case.
+
+=item B<urn>:B<isbn>:
+
+The C<urn:isbn:> namespace contains International Standard Book
+Numbers (ISBNs) and is described in RFC 3187. A C<URI> object belonging
+to this namespace has the following extra methods (if the
+Business::ISBN module is available): $uri->isbn,
+$uri->isbn_publisher_code, $uri->isbn_group_code (formerly isbn_country_code,
+which is still supported by issues a deprecation warning), $uri->isbn_as_ean.
+
+=item B<urn>:B<oid>:
+
+The C<urn:oid:> namespace contains Object Identifiers (OIDs) and is
+described in RFC 3061. An object identifier consists of sequences of digits
+separated by dots. A C<URI> object belonging to this namespace has an
+additional method called $uri->oid that can be used to get/set the oid
+value. In a list context, oid numbers are returned as separate elements.
+
+=back
+
+=head1 CONFIGURATION VARIABLES
+
+The following configuration variables influence how the class and its
+methods behave:
+
+=over 4
+
+=item $URI::ABS_ALLOW_RELATIVE_SCHEME
+
+Some older parsers used to allow the scheme name to be present in the
+relative URL if it was the same as the base URL scheme. RFC 2396 says
+that this should be avoided, but you can enable this old behaviour by
+setting the $URI::ABS_ALLOW_RELATIVE_SCHEME variable to a TRUE value.
+The difference is demonstrated by the following examples:
+
+ URI->new("http:foo")->abs("http://host/a/b")
+ ==> "http:foo"
+
+ local $URI::ABS_ALLOW_RELATIVE_SCHEME = 1;
+ URI->new("http:foo")->abs("http://host/a/b")
+ ==> "http:/host/a/foo"
+
+
+=item $URI::ABS_REMOTE_LEADING_DOTS
+
+You can also have the abs() method ignore excess ".."
+segments in the relative URI by setting $URI::ABS_REMOTE_LEADING_DOTS
+to a TRUE value. The difference is demonstrated by the following
+examples:
+
+ URI->new("../../../foo")->abs("http://host/a/b")
+ ==> "http://host/../../foo"
+
+ local $URI::ABS_REMOTE_LEADING_DOTS = 1;
+ URI->new("../../../foo")->abs("http://host/a/b")
+ ==> "http://host/foo"
+
+=item $URI::DEFAULT_QUERY_FORM_DELIMITER
+
+This value can be set to ";" to have the query form C<key=value> pairs
+delimited by ";" instead of "&" which is the default.
+
+=back
+
+=head1 BUGS
+
+There are some things that are not quite right:
+
+=over
+
+=item *
+
+Using regexp variables like $1 directly as arguments to the URI accessor methods
+does not work too well with current perl implementations. I would argue
+that this is actually a bug in perl. The workaround is to quote
+them. Example:
+
+ /(...)/ || die;
+ $u->query("$1");
+
+
+=item *
+
+The escaping (percent encoding) of chars in the 128 .. 255 range passed to the
+URI constructor or when setting URI parts using the accessor methods depend on
+the state of the internal UTF8 flag (see utf8::is_utf8) of the string passed.
+If the UTF8 flag is set the UTF-8 encoded version of the character is percent
+encoded. If the UTF8 flag isn't set the Latin-1 version (byte) of the
+character is percent encoded. This basically exposes the internal encoding of
+Perl strings.
+
+=back
+
+=head1 PARSING URIs WITH REGEXP
+
+As an alternative to this module, the following (official) regular
+expression can be used to decode a URI:
+
+ my($scheme, $authority, $path, $query, $fragment) =
+ $uri =~ m|(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?|;
+
+The C<URI::Split> module provides the function uri_split() as a
+readable alternative.
+
+=head1 SEE ALSO
+
+L<URI::file>, L<URI::WithBase>, L<URI::QueryParam>, L<URI::Escape>,
+L<URI::Split>, L<URI::Heuristic>
+
+RFC 2396: "Uniform Resource Identifiers (URI): Generic Syntax",
+Berners-Lee, Fielding, Masinter, August 1998.
+
+L<http://www.iana.org/assignments/uri-schemes>
+
+L<http://www.iana.org/assignments/urn-namespaces>
+
+L<http://www.w3.org/Addressing/>
+
+=head1 COPYRIGHT
+
+Copyright 1995-2009 Gisle Aas.
+
+Copyright 1995 Martijn Koster.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=head1 AUTHORS / ACKNOWLEDGMENTS
+
+This module is based on the C<URI::URL> module, which in turn was
+(distantly) based on the C<wwwurl.pl> code in the libwww-perl for
+perl4 developed by Roy Fielding, as part of the Arcadia project at the
+University of California, Irvine, with contributions from Brooks
+Cutter.
+
+C<URI::URL> was developed by Gisle Aas, Tim Bunce, Roy Fielding and
+Martijn Koster with input from other people on the libwww-perl mailing
+list.
+
+C<URI> and related subclasses was developed by Gisle Aas.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm
new file mode 100644
index 0000000000..f9392d446f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Escape.pm
@@ -0,0 +1,221 @@
+package URI::Escape;
+
+use strict;
+use warnings;
+
+=head1 NAME
+
+URI::Escape - Percent-encode and percent-decode unsafe characters
+
+=head1 SYNOPSIS
+
+ use URI::Escape;
+ $safe = uri_escape("10% is enough\n");
+ $verysafe = uri_escape("foo", "\0-\377");
+ $str = uri_unescape($safe);
+
+=head1 DESCRIPTION
+
+This module provides functions to percent-encode and percent-decode URI strings as
+defined by RFC 3986. Percent-encoding URI's is informally called "URI escaping".
+This is the terminology used by this module, which predates the formalization of the
+terms by the RFC by several years.
+
+A URI consists of a restricted set of characters. The restricted set
+of characters consists of digits, letters, and a few graphic symbols
+chosen from those common to most of the character encodings and input
+facilities available to Internet users. They are made up of the
+"unreserved" and "reserved" character sets as defined in RFC 3986.
+
+ unreserved = ALPHA / DIGIT / "-" / "." / "_" / "~"
+ reserved = ":" / "/" / "?" / "#" / "[" / "]" / "@"
+ "!" / "$" / "&" / "'" / "(" / ")"
+ / "*" / "+" / "," / ";" / "="
+
+In addition, any byte (octet) can be represented in a URI by an escape
+sequence: a triplet consisting of the character "%" followed by two
+hexadecimal digits. A byte can also be represented directly by a
+character, using the US-ASCII character for that octet.
+
+Some of the characters are I<reserved> for use as delimiters or as
+part of certain URI components. These must be escaped if they are to
+be treated as ordinary data. Read RFC 3986 for further details.
+
+The functions provided (and exported by default) from this module are:
+
+=over 4
+
+=item uri_escape( $string )
+
+=item uri_escape( $string, $unsafe )
+
+Replaces each unsafe character in the $string with the corresponding
+escape sequence and returns the result. The $string argument should
+be a string of bytes. The uri_escape() function will croak if given a
+characters with code above 255. Use uri_escape_utf8() if you know you
+have such chars or/and want chars in the 128 .. 255 range treated as
+UTF-8.
+
+The uri_escape() function takes an optional second argument that
+overrides the set of characters that are to be escaped. The set is
+specified as a string that can be used in a regular expression
+character class (between [ ]). E.g.:
+
+ "\x00-\x1f\x7f-\xff" # all control and hi-bit characters
+ "a-z" # all lower case characters
+ "^A-Za-z" # everything not a letter
+
+The default set of characters to be escaped is all those which are
+I<not> part of the C<unreserved> character class shown above as well
+as the reserved characters. I.e. the default is:
+
+ "^A-Za-z0-9\-\._~"
+
+=item uri_escape_utf8( $string )
+
+=item uri_escape_utf8( $string, $unsafe )
+
+Works like uri_escape(), but will encode chars as UTF-8 before
+escaping them. This makes this function able to deal with characters
+with code above 255 in $string. Note that chars in the 128 .. 255
+range will be escaped differently by this function compared to what
+uri_escape() would. For chars in the 0 .. 127 range there is no
+difference.
+
+Equivalent to:
+
+ utf8::encode($string);
+ my $uri = uri_escape($string);
+
+Note: JavaScript has a function called escape() that produces the
+sequence "%uXXXX" for chars in the 256 .. 65535 range. This function
+has really nothing to do with URI escaping but some folks got confused
+since it "does the right thing" in the 0 .. 255 range. Because of
+this you sometimes see "URIs" with these kind of escapes. The
+JavaScript encodeURIComponent() function is similar to uri_escape_utf8().
+
+=item uri_unescape($string,...)
+
+Returns a string with each %XX sequence replaced with the actual byte
+(octet).
+
+This does the same as:
+
+ $string =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+
+but does not modify the string in-place as this RE would. Using the
+uri_unescape() function instead of the RE might make the code look
+cleaner and is a few characters less to type.
+
+In a simple benchmark test I did,
+calling the function (instead of the inline RE above) if a few chars
+were unescaped was something like 40% slower, and something like 700% slower if none were. If
+you are going to unescape a lot of times it might be a good idea to
+inline the RE.
+
+If the uri_unescape() function is passed multiple strings, then each
+one is returned unescaped.
+
+=back
+
+The module can also export the C<%escapes> hash, which contains the
+mapping from all 256 bytes to the corresponding escape codes. Lookup
+in this hash is faster than evaluating C<sprintf("%%%02X", ord($byte))>
+each time.
+
+=head1 SEE ALSO
+
+L<URI>
+
+
+=head1 COPYRIGHT
+
+Copyright 1995-2004 Gisle Aas.
+
+This program is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+use Exporter 5.57 'import';
+our %escapes;
+our @EXPORT = qw(uri_escape uri_unescape uri_escape_utf8);
+our @EXPORT_OK = qw(%escapes);
+our $VERSION = "3.31";
+
+use Carp ();
+
+# Build a char->hex map
+for (0..255) {
+ $escapes{chr($_)} = sprintf("%%%02X", $_);
+}
+
+my %subst; # compiled patterns
+
+my %Unsafe = (
+ RFC2732 => qr/[^A-Za-z0-9\-_.!~*'()]/,
+ RFC3986 => qr/[^A-Za-z0-9\-\._~]/,
+);
+
+sub uri_escape {
+ my($text, $patn) = @_;
+ return undef unless defined $text;
+ 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 $@;
+ }
+ &{$subst{$patn}}($text);
+ } else {
+ $text =~ s/($Unsafe{RFC3986})/$escapes{$1} || _fail_hi($1)/ge;
+ }
+ $text;
+}
+
+sub _fail_hi {
+ my $chr = shift;
+ Carp::croak(sprintf "Can't escape \\x{%04X}, try uri_escape_utf8() instead", ord($chr));
+}
+
+sub uri_escape_utf8 {
+ my $text = shift;
+ return undef unless defined $text;
+ utf8::encode($text);
+ return uri_escape($text, @_);
+}
+
+sub uri_unescape {
+ # Note from RFC1630: "Sequences which start with a percent sign
+ # but are not followed by two hexadecimal characters are reserved
+ # for future extension"
+ my $str = shift;
+ if (@_ && wantarray) {
+ # not executed for the common case of a single argument
+ my @str = ($str, @_); # need to copy
+ for (@str) {
+ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg;
+ }
+ return @str;
+ }
+ $str =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg if defined $str;
+ $str;
+}
+
+# XXX FIXME escape_char is buggy as it assigns meaning to the string's storage format.
+sub escape_char {
+ # Old versions of utf8::is_utf8() didn't properly handle magical vars (e.g. $1).
+ # The following forces a fetch to occur beforehand.
+ my $dummy = substr($_[0], 0, 0);
+
+ if (utf8::is_utf8($_[0])) {
+ my $s = shift;
+ utf8::encode($s);
+ unshift(@_, $s);
+ }
+
+ return join '', @URI::Escape::escapes{split //, $_[0]};
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm
new file mode 100644
index 0000000000..d4ace34379
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Heuristic.pm
@@ -0,0 +1,253 @@
+package URI::Heuristic;
+
+=head1 NAME
+
+URI::Heuristic - Expand URI using heuristics
+
+=head1 SYNOPSIS
+
+ use URI::Heuristic qw(uf_uristr);
+ $u = uf_uristr("perl"); # http://www.perl.com
+ $u = uf_uristr("www.sol.no/sol"); # http://www.sol.no/sol
+ $u = uf_uristr("aas"); # http://www.aas.no
+ $u = uf_uristr("ftp.funet.fi"); # ftp://ftp.funet.fi
+ $u = uf_uristr("/etc/passwd"); # file:/etc/passwd
+
+=head1 DESCRIPTION
+
+This module provides functions that expand strings into real absolute
+URIs using some built-in heuristics. Strings that already represent
+absolute URIs (i.e. that start with a C<scheme:> part) are never modified
+and are returned unchanged. The main use of these functions is to
+allow abbreviated URIs similar to what many web browsers allow for URIs
+typed in by the user.
+
+The following functions are provided:
+
+=over 4
+
+=item uf_uristr($str)
+
+Tries to make the argument string
+into a proper absolute URI string. The "uf_" prefix stands for "User
+Friendly". Under MacOS, it assumes that any string with a common URL
+scheme (http, ftp, etc.) is a URL rather than a local path. So don't name
+your volumes after common URL schemes and expect uf_uristr() to construct
+valid file: URL's on those volumes for you, because it won't.
+
+=item uf_uri($str)
+
+Works the same way as uf_uristr() but
+returns a C<URI> object.
+
+=back
+
+=head1 ENVIRONMENT
+
+If the hostname portion of a URI does not contain any dots, then
+certain qualified guesses are made. These guesses are governed by
+the following environment variables:
+
+=over 10
+
+=item COUNTRY
+
+The two-letter country code (ISO 3166) for your location. If
+the domain name of your host ends with two letters, then it is taken
+to be the default country. See also L<Locale::Country>.
+
+=item HTTP_ACCEPT_LANGUAGE, LC_ALL, LANG
+
+If COUNTRY is not set, these standard environment variables are
+examined and country (not language) information possibly found in them
+is used as the default country.
+
+=item URL_GUESS_PATTERN
+
+Contains a space-separated list of URL patterns to try. The string
+"ACME" is for some reason used as a placeholder for the host name in
+the URL provided. Example:
+
+ URL_GUESS_PATTERN="www.ACME.no www.ACME.se www.ACME.com"
+ export URL_GUESS_PATTERN
+
+Specifying URL_GUESS_PATTERN disables any guessing rules based on
+country. An empty URL_GUESS_PATTERN disables any guessing that
+involves host name lookups.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 1997-1998, Gisle Aas
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
+use strict;
+use warnings;
+
+use Exporter 5.57 'import';
+our @EXPORT_OK = qw(uf_uri uf_uristr uf_url uf_urlstr);
+our $VERSION = "4.20";
+
+our ($MY_COUNTRY, $DEBUG);
+
+sub MY_COUNTRY() {
+ for ($MY_COUNTRY) {
+ return $_ if defined;
+
+ # First try the environment.
+ $_ = $ENV{COUNTRY};
+ return $_ if defined;
+
+ # Try the country part of LC_ALL and LANG from environment
+ my @srcs = ($ENV{LC_ALL}, $ENV{LANG});
+ # ...and HTTP_ACCEPT_LANGUAGE before those if present
+ if (my $httplang = $ENV{HTTP_ACCEPT_LANGUAGE}) {
+ # TODO: q-value processing/ordering
+ for $httplang (split(/\s*,\s*/, $httplang)) {
+ if ($httplang =~ /^\s*([a-zA-Z]+)[_-]([a-zA-Z]{2})\s*$/) {
+ unshift(@srcs, "${1}_${2}");
+ last;
+ }
+ }
+ }
+ for (@srcs) {
+ next unless defined;
+ return lc($1) if /^[a-zA-Z]+_([a-zA-Z]{2})(?:[.@]|$)/;
+ }
+
+ # Last bit of domain name. This may access the network.
+ require Net::Domain;
+ my $fqdn = Net::Domain::hostfqdn();
+ $_ = lc($1) if $fqdn =~ /\.([a-zA-Z]{2})$/;
+ return $_ if defined;
+
+ # Give up. Defined but false.
+ return ($_ = 0);
+ }
+}
+
+our %LOCAL_GUESSING =
+(
+ 'us' => [qw(www.ACME.gov www.ACME.mil)],
+ 'gb' => [qw(www.ACME.co.uk www.ACME.org.uk www.ACME.ac.uk)],
+ 'au' => [qw(www.ACME.com.au www.ACME.org.au www.ACME.edu.au)],
+ 'il' => [qw(www.ACME.co.il www.ACME.org.il www.ACME.net.il)],
+ # send corrections and new entries to <gisle@aas.no>
+);
+# Backwards compatibility; uk != United Kingdom in ISO 3166
+$LOCAL_GUESSING{uk} = $LOCAL_GUESSING{gb};
+
+
+sub uf_uristr ($)
+{
+ local($_) = @_;
+ print STDERR "uf_uristr: resolving $_\n" if $DEBUG;
+ return unless defined;
+
+ s/^\s+//;
+ s/\s+$//;
+
+ if (/^(www|web|home)[a-z0-9-]*(?:\.|$)/i) {
+ $_ = "http://$_";
+
+ } elsif (/^(ftp|gopher|news|wais|https|http)[a-z0-9-]*(?:\.|$)/i) {
+ $_ = lc($1) . "://$_";
+
+ } elsif ($^O ne "MacOS" &&
+ (m,^/, || # absolute file name
+ m,^\.\.?/, || # relative file name
+ m,^[a-zA-Z]:[/\\],) # dosish file name
+ )
+ {
+ $_ = "file:$_";
+
+ } elsif ($^O eq "MacOS" && m/:/) {
+ # potential MacOS file name
+ unless (m/^(ftp|gopher|news|wais|http|https|mailto):/) {
+ require URI::file;
+ my $a = URI::file->new($_)->as_string;
+ $_ = ($a =~ m/^file:/) ? $a : "file:$a";
+ }
+ } elsif (/^\w+([\.\-]\w+)*\@(\w+\.)+\w{2,3}$/) {
+ $_ = "mailto:$_";
+
+ } elsif (!/^[a-zA-Z][a-zA-Z0-9.+\-]*:/) { # no scheme specified
+ if (s/^([-\w]+(?:\.[-\w]+)*)([\/:\?\#]|$)/$2/) {
+ my $host = $1;
+
+ my $scheme = "http";
+ if (/^:(\d+)\b/) {
+ # Some more or less well known ports
+ if ($1 =~ /^[56789]?443$/) {
+ $scheme = "https";
+ } elsif ($1 eq "21") {
+ $scheme = "ftp";
+ }
+ }
+
+ if ($host !~ /\./ && $host ne "localhost") {
+ my @guess;
+ if (exists $ENV{URL_GUESS_PATTERN}) {
+ @guess = map { s/\bACME\b/$host/; $_ }
+ split(' ', $ENV{URL_GUESS_PATTERN});
+ } else {
+ if (MY_COUNTRY()) {
+ my $special = $LOCAL_GUESSING{MY_COUNTRY()};
+ if ($special) {
+ my @special = @$special;
+ push(@guess, map { s/\bACME\b/$host/; $_ }
+ @special);
+ } else {
+ push(@guess, "www.$host." . MY_COUNTRY());
+ }
+ }
+ push(@guess, map "www.$host.$_",
+ "com", "org", "net", "edu", "int");
+ }
+
+
+ my $guess;
+ for $guess (@guess) {
+ print STDERR "uf_uristr: gethostbyname('$guess.')..."
+ if $DEBUG;
+ if (gethostbyname("$guess.")) {
+ print STDERR "yes\n" if $DEBUG;
+ $host = $guess;
+ last;
+ }
+ print STDERR "no\n" if $DEBUG;
+ }
+ }
+ $_ = "$scheme://$host$_";
+
+ } else {
+ # pure junk, just return it unchanged...
+
+ }
+ }
+ print STDERR "uf_uristr: ==> $_\n" if $DEBUG;
+
+ $_;
+}
+
+sub uf_uri ($)
+{
+ require URI;
+ URI->new(uf_uristr($_[0]));
+}
+
+# legacy
+*uf_urlstr = \*uf_uristr;
+
+sub uf_url ($)
+{
+ require URI::URL;
+ URI::URL->new(uf_uristr($_[0]));
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm
new file mode 100644
index 0000000000..edb10450f7
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/IRI.pm
@@ -0,0 +1,47 @@
+package URI::IRI;
+
+# Experimental
+
+use strict;
+use warnings;
+use URI ();
+
+use overload '""' => sub { shift->as_string };
+
+our $VERSION = '1.76';
+
+sub new {
+ my($class, $uri, $scheme) = @_;
+ utf8::upgrade($uri);
+ return bless {
+ uri => URI->new($uri, $scheme),
+ }, $class;
+}
+
+sub clone {
+ my $self = shift;
+ return bless {
+ uri => $self->{uri}->clone,
+ }, ref($self);
+}
+
+sub as_string {
+ my $self = shift;
+ return $self->{uri}->as_iri;
+}
+
+our $AUTOLOAD;
+sub AUTOLOAD
+{
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
+
+ # We create the function here so that it will not need to be
+ # autoloaded the next time.
+ no strict 'refs';
+ *$method = sub { shift->{uri}->$method(@_) };
+ goto &$method;
+}
+
+sub DESTROY {} # avoid AUTOLOADing it
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm
new file mode 100644
index 0000000000..16eed9823d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/QueryParam.pm
@@ -0,0 +1,207 @@
+package URI::QueryParam;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+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;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+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>
+
+=head1 COPYRIGHT
+
+Copyright 2002 Gisle Aas.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm
new file mode 100644
index 0000000000..39b5bcf7f2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/Split.pm
@@ -0,0 +1,97 @@
+package URI::Split;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use Exporter 5.57 'import';
+our @EXPORT_OK = qw(uri_split uri_join);
+
+use URI::Escape ();
+
+sub uri_split {
+ return $_[0] =~ m,(?:([^:/?#]+):)?(?://([^/?#]*))?([^?#]*)(?:\?([^#]*))?(?:#(.*))?,;
+}
+
+sub uri_join {
+ my($scheme, $auth, $path, $query, $frag) = @_;
+ my $uri = defined($scheme) ? "$scheme:" : "";
+ $path = "" unless defined $path;
+ if (defined $auth) {
+ $auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;
+ $uri .= "//$auth";
+ $path = "/$path" if length($path) && $path !~ m,^/,;
+ }
+ elsif ($path =~ m,^//,) {
+ $uri .= "//"; # XXX force empty auth
+ }
+ unless (length $uri) {
+ $path =~ s,(:), URI::Escape::escape_char($1),e while $path =~ m,^[^:/?\#]+:,;
+ }
+ $path =~ s,([?\#]), URI::Escape::escape_char($1),eg;
+ $uri .= $path;
+ if (defined $query) {
+ $query =~ s,(\#), URI::Escape::escape_char($1),eg;
+ $uri .= "?$query";
+ }
+ $uri .= "#$frag" if defined $frag;
+ $uri;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+URI::Split - Parse and compose URI strings
+
+=head1 SYNOPSIS
+
+ use URI::Split qw(uri_split uri_join);
+ ($scheme, $auth, $path, $query, $frag) = uri_split($uri);
+ $uri = uri_join($scheme, $auth, $path, $query, $frag);
+
+=head1 DESCRIPTION
+
+Provides functions to parse and compose URI
+strings. The following functions are provided:
+
+=over
+
+=item ($scheme, $auth, $path, $query, $frag) = uri_split($uri)
+
+Breaks up a URI string into its component
+parts. An C<undef> value is returned for those parts that are not
+present. The $path part is always present (but can be the empty
+string) and is thus never returned as C<undef>.
+
+No sensible value is returned if this function is called in a scalar
+context.
+
+=item $uri = uri_join($scheme, $auth, $path, $query, $frag)
+
+Puts together a URI string from its parts.
+Missing parts are signaled by passing C<undef> for the corresponding
+argument.
+
+Minimal escaping is applied to parts that contain reserved chars
+that would confuse a parser. For instance, any occurrence of '?' or '#'
+in $path is always escaped, as it would otherwise be parsed back
+as a query or fragment.
+
+=back
+
+=head1 SEE ALSO
+
+L<URI>, L<URI::Escape>
+
+=head1 COPYRIGHT
+
+Copyright 2003, 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/URI/URL.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm
new file mode 100644
index 0000000000..ba05ecaeba
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/URL.pm
@@ -0,0 +1,303 @@
+package URI::URL;
+
+use strict;
+use warnings;
+
+use parent 'URI::WithBase';
+
+our $VERSION = "5.04";
+
+# Provide as much as possible of the old URI::URL interface for backwards
+# compatibility...
+
+use Exporter 5.57 'import';
+our @EXPORT = qw(url);
+
+# Easy to use constructor
+sub url ($;$) { URI::URL->new(@_); }
+
+use URI::Escape qw(uri_unescape);
+
+sub new
+{
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+ $self->[0] = $self->[0]->canonical;
+ $self;
+}
+
+sub newlocal
+{
+ my $class = shift;
+ require URI::file;
+ bless [URI::file->new_abs(shift)], $class;
+}
+
+{package URI::_foreign;
+ sub _init # hope it is not defined
+ {
+ my $class = shift;
+ die "Unknown URI::URL scheme $_[1]:" if $URI::URL::STRICT;
+ $class->SUPER::_init(@_);
+ }
+}
+
+sub strict
+{
+ my $old = $URI::URL::STRICT;
+ $URI::URL::STRICT = shift if @_;
+ $old;
+}
+
+sub print_on
+{
+ my $self = shift;
+ require Data::Dumper;
+ print STDERR Data::Dumper::Dumper($self);
+}
+
+sub _try
+{
+ my $self = shift;
+ my $method = shift;
+ scalar(eval { $self->$method(@_) });
+}
+
+sub crack
+{
+ # should be overridden by subclasses
+ my $self = shift;
+ (scalar($self->scheme),
+ $self->_try("user"),
+ $self->_try("password"),
+ $self->_try("host"),
+ $self->_try("port"),
+ $self->_try("path"),
+ $self->_try("params"),
+ $self->_try("query"),
+ scalar($self->fragment),
+ )
+}
+
+sub full_path
+{
+ my $self = shift;
+ my $path = $self->path_query;
+ $path = "/" unless length $path;
+ $path;
+}
+
+sub netloc
+{
+ shift->authority(@_);
+}
+
+sub epath
+{
+ my $path = shift->SUPER::path(@_);
+ $path =~ s/;.*//;
+ $path;
+}
+
+sub eparams
+{
+ my $self = shift;
+ my @p = $self->path_segments;
+ return undef unless ref($p[-1]);
+ @p = @{$p[-1]};
+ shift @p;
+ join(";", @p);
+}
+
+sub params { shift->eparams(@_); }
+
+sub path {
+ my $self = shift;
+ my $old = $self->epath(@_);
+ return unless defined wantarray;
+ return '/' if !defined($old) || !length($old);
+ Carp::croak("Path components contain '/' (you must call epath)")
+ if $old =~ /%2[fF]/ and !@_;
+ $old = "/$old" if $old !~ m|^/| && defined $self->netloc;
+ return uri_unescape($old);
+}
+
+sub path_components {
+ shift->path_segments(@_);
+}
+
+sub query {
+ my $self = shift;
+ my $old = $self->equery(@_);
+ if (defined(wantarray) && defined($old)) {
+ if ($old =~ /%(?:26|2[bB]|3[dD])/) { # contains escaped '=' '&' or '+'
+ my $mess;
+ for ($old) {
+ $mess = "Query contains both '+' and '%2B'"
+ if /\+/ && /%2[bB]/;
+ $mess = "Form query contains escaped '=' or '&'"
+ if /=/ && /%(?:3[dD]|26)/;
+ }
+ if ($mess) {
+ Carp::croak("$mess (you must call equery)");
+ }
+ }
+ # Now it should be safe to unescape the string without losing
+ # information
+ return uri_unescape($old);
+ }
+ undef;
+
+}
+
+sub abs
+{
+ my $self = shift;
+ my $base = shift;
+ my $allow_scheme = shift;
+ $allow_scheme = $URI::URL::ABS_ALLOW_RELATIVE_SCHEME
+ unless defined $allow_scheme;
+ local $URI::ABS_ALLOW_RELATIVE_SCHEME = $allow_scheme;
+ local $URI::ABS_REMOTE_LEADING_DOTS = $URI::URL::ABS_REMOTE_LEADING_DOTS;
+ $self->SUPER::abs($base);
+}
+
+sub frag { shift->fragment(@_); }
+sub keywords { shift->query_keywords(@_); }
+
+# file:
+sub local_path { shift->file; }
+sub unix_path { shift->file("unix"); }
+sub dos_path { shift->file("dos"); }
+sub mac_path { shift->file("mac"); }
+sub vms_path { shift->file("vms"); }
+
+# mailto:
+sub address { shift->to(@_); }
+sub encoded822addr { shift->to(@_); }
+sub URI::mailto::authority { shift->to(@_); } # make 'netloc' method work
+
+# news:
+sub groupart { shift->_group(@_); }
+sub article { shift->message(@_); }
+
+1;
+
+__END__
+
+=head1 NAME
+
+URI::URL - Uniform Resource Locators
+
+=head1 SYNOPSIS
+
+ $u1 = URI::URL->new($str, $base);
+ $u2 = $u1->abs;
+
+=head1 DESCRIPTION
+
+This module is provided for backwards compatibility with modules that
+depend on the interface provided by the C<URI::URL> class that used to
+be distributed with the libwww-perl library.
+
+The following differences exist compared to the C<URI> class interface:
+
+=over 3
+
+=item *
+
+The URI::URL module exports the url() function as an alternate
+constructor interface.
+
+=item *
+
+The constructor takes an optional $base argument. The C<URI::URL>
+class is a subclass of C<URI::WithBase>.
+
+=item *
+
+The URI::URL->newlocal class method is the same as URI::file->new_abs.
+
+=item *
+
+URI::URL::strict(1)
+
+=item *
+
+$url->print_on method
+
+=item *
+
+$url->crack method
+
+=item *
+
+$url->full_path: same as ($uri->abs_path || "/")
+
+=item *
+
+$url->netloc: same as $uri->authority
+
+=item *
+
+$url->epath, $url->equery: same as $uri->path, $uri->query
+
+=item *
+
+$url->path and $url->query pass unescaped strings.
+
+=item *
+
+$url->path_components: same as $uri->path_segments (if you don't
+consider path segment parameters)
+
+=item *
+
+$url->params and $url->eparams methods
+
+=item *
+
+$url->base method. See L<URI::WithBase>.
+
+=item *
+
+$url->abs and $url->rel have an optional $base argument. See
+L<URI::WithBase>.
+
+=item *
+
+$url->frag: same as $uri->fragment
+
+=item *
+
+$url->keywords: same as $uri->query_keywords
+
+=item *
+
+$url->localpath and friends map to $uri->file.
+
+=item *
+
+$url->address and $url->encoded822addr: same as $uri->to for mailto URI
+
+=item *
+
+$url->groupart method for news URI
+
+=item *
+
+$url->article: same as $uri->message
+
+=back
+
+
+
+=head1 SEE ALSO
+
+L<URI>, L<URI::WithBase>
+
+=head1 COPYRIGHT
+
+Copyright 1998-2000 Gisle Aas.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm
new file mode 100644
index 0000000000..943b7b533a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/WithBase.pm
@@ -0,0 +1,174 @@
+package URI::WithBase;
+
+use strict;
+use warnings;
+
+use URI;
+use Scalar::Util 'blessed';
+
+our $VERSION = "2.20";
+
+use overload '""' => "as_string", fallback => 1;
+
+sub as_string; # help overload find it
+
+sub new
+{
+ my($class, $uri, $base) = @_;
+ my $ibase = $base;
+ if ($base && blessed($base) && $base->isa(__PACKAGE__)) {
+ $base = $base->abs;
+ $ibase = $base->[0];
+ }
+ bless [URI->new($uri, $ibase), $base], $class;
+}
+
+sub new_abs
+{
+ my $class = shift;
+ my $self = $class->new(@_);
+ $self->abs;
+}
+
+sub _init
+{
+ my $class = shift;
+ my($str, $scheme) = @_;
+ bless [URI->new($str, $scheme), undef], $class;
+}
+
+sub eq
+{
+ my($self, $other) = @_;
+ $other = $other->[0] if blessed($other) and $other->isa(__PACKAGE__);
+ $self->[0]->eq($other);
+}
+
+our $AUTOLOAD;
+sub AUTOLOAD
+{
+ my $self = shift;
+ my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::')+2);
+ return if $method eq "DESTROY";
+ $self->[0]->$method(@_);
+}
+
+sub can { # override UNIVERSAL::can
+ my $self = shift;
+ $self->SUPER::can(@_) || (
+ ref($self)
+ ? $self->[0]->can(@_)
+ : undef
+ )
+}
+
+sub base {
+ my $self = shift;
+ my $base = $self->[1];
+
+ if (@_) { # set
+ my $new_base = shift;
+ # ensure absoluteness
+ $new_base = $new_base->abs if ref($new_base) && $new_base->isa(__PACKAGE__);
+ $self->[1] = $new_base;
+ }
+ return unless defined wantarray;
+
+ # The base attribute supports 'lazy' conversion from URL strings
+ # to URL objects. Strings may be stored but when a string is
+ # fetched it will automatically be converted to a URL object.
+ # The main benefit is to make it much cheaper to say:
+ # URI::WithBase->new($random_url_string, 'http:')
+ if (defined($base) && !ref($base)) {
+ $base = ref($self)->new($base);
+ $self->[1] = $base unless @_;
+ }
+ $base;
+}
+
+sub clone
+{
+ my $self = shift;
+ my $base = $self->[1];
+ $base = $base->clone if ref($base);
+ bless [$self->[0]->clone, $base], ref($self);
+}
+
+sub abs
+{
+ my $self = shift;
+ my $base = shift || $self->base || return $self->clone;
+ $base = $base->as_string if ref($base);
+ bless [$self->[0]->abs($base, @_), $base], ref($self);
+}
+
+sub rel
+{
+ my $self = shift;
+ my $base = shift || $self->base || return $self->clone;
+ $base = $base->as_string if ref($base);
+ bless [$self->[0]->rel($base, @_), $base], ref($self);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+URI::WithBase - URIs which remember their base
+
+=head1 SYNOPSIS
+
+ $u1 = URI::WithBase->new($str, $base);
+ $u2 = $u1->abs;
+
+ $base = $u1->base;
+ $u1->base( $new_base )
+
+=head1 DESCRIPTION
+
+This module provides the C<URI::WithBase> class. Objects of this class
+are like C<URI> objects, but can keep their base too. The base
+represents the context where this URI was found and can be used to
+absolutize or relativize the URI. All the methods described in L<URI>
+are supported for C<URI::WithBase> objects.
+
+The methods provided in addition to or modified from those of C<URI> are:
+
+=over 4
+
+=item $uri = URI::WithBase->new($str, [$base])
+
+The constructor takes an optional base URI as the second argument.
+If provided, this argument initializes the base attribute.
+
+=item $uri->base( [$new_base] )
+
+Can be used to get or set the value of the base attribute.
+The return value, which is the old value, is a URI object or C<undef>.
+
+=item $uri->abs( [$base_uri] )
+
+The $base_uri argument is now made optional as the object carries its
+base with it. A new object is returned even if $uri is already
+absolute (while plain URI objects simply return themselves in
+that case).
+
+=item $uri->rel( [$base_uri] )
+
+The $base_uri argument is now made optional as the object carries its
+base with it. A new object is always returned.
+
+=back
+
+
+=head1 SEE ALSO
+
+L<URI>
+
+=head1 COPYRIGHT
+
+Copyright 1998-2002 Gisle Aas.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm
new file mode 100644
index 0000000000..d556c853e6
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_foreign.pm
@@ -0,0 +1,10 @@
+package URI::_foreign;
+
+use strict;
+use warnings;
+
+use parent 'URI::_generic';
+
+our $VERSION = '1.76';
+
+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
new file mode 100644
index 0000000000..0da8f72998
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_generic.pm
@@ -0,0 +1,256 @@
+package URI::_generic;
+
+use strict;
+use warnings;
+
+use parent qw(URI URI::_query);
+
+use URI::Escape qw(uri_unescape);
+use Carp ();
+
+our $VERSION = '1.76';
+
+my $ACHAR = $URI::uric; $ACHAR =~ s,\\[/?],,g;
+my $PCHAR = $URI::uric; $PCHAR =~ s,\\[?],,g;
+
+sub _no_scheme_ok { 1 }
+
+sub authority
+{
+ my $self = shift;
+ $$self =~ m,^((?:$URI::scheme_re:)?)(?://([^/?\#]*))?(.*)$,os or die;
+
+ if (@_) {
+ my $auth = shift;
+ $$self = $1;
+ my $rest = $3;
+ if (defined $auth) {
+ $auth =~ s/([^$ACHAR])/ URI::Escape::escape_char($1)/ego;
+ utf8::downgrade($auth);
+ $$self .= "//$auth";
+ }
+ _check_path($rest, $$self);
+ $$self .= $rest;
+ }
+ $2;
+}
+
+sub path
+{
+ my $self = shift;
+ $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^?\#]*)(.*)$,s or die;
+
+ if (@_) {
+ $$self = $1;
+ my $rest = $3;
+ my $new_path = shift;
+ $new_path = "" unless defined $new_path;
+ $new_path =~ s/([^$PCHAR])/ URI::Escape::escape_char($1)/ego;
+ utf8::downgrade($new_path);
+ _check_path($new_path, $$self);
+ $$self .= $new_path . $rest;
+ }
+ $2;
+}
+
+sub path_query
+{
+ my $self = shift;
+ $$self =~ m,^((?:[^:/?\#]+:)?(?://[^/?\#]*)?)([^\#]*)(.*)$,s or die;
+
+ if (@_) {
+ $$self = $1;
+ my $rest = $3;
+ my $new_path = shift;
+ $new_path = "" unless defined $new_path;
+ $new_path =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
+ utf8::downgrade($new_path);
+ _check_path($new_path, $$self);
+ $$self .= $new_path . $rest;
+ }
+ $2;
+}
+
+sub _check_path
+{
+ my($path, $pre) = @_;
+ my $prefix;
+ if ($pre =~ m,/,) { # authority present
+ $prefix = "/" if length($path) && $path !~ m,^[/?\#],;
+ }
+ else {
+ if ($path =~ m,^//,) {
+ Carp::carp("Path starting with double slash is confusing")
+ if $^W;
+ }
+ elsif (!length($pre) && $path =~ m,^[^:/?\#]+:,) {
+ Carp::carp("Path might look like scheme, './' prepended")
+ if $^W;
+ $prefix = "./";
+ }
+ }
+ substr($_[0], 0, 0) = $prefix if defined $prefix;
+}
+
+sub path_segments
+{
+ my $self = shift;
+ my $path = $self->path;
+ if (@_) {
+ my @arg = @_; # make a copy
+ for (@arg) {
+ if (ref($_)) {
+ my @seg = @$_;
+ $seg[0] =~ s/%/%25/g;
+ for (@seg) { s/;/%3B/g; }
+ $_ = join(";", @seg);
+ }
+ else {
+ s/%/%25/g; s/;/%3B/g;
+ }
+ s,/,%2F,g;
+ }
+ $self->path(join("/", @arg));
+ }
+ return $path unless wantarray;
+ map {/;/ ? $self->_split_segment($_)
+ : uri_unescape($_) }
+ split('/', $path, -1);
+}
+
+
+sub _split_segment
+{
+ my $self = shift;
+ require URI::_segment;
+ URI::_segment->new(@_);
+}
+
+
+sub abs
+{
+ my $self = shift;
+ my $base = shift || Carp::croak("Missing base argument");
+
+ if (my $scheme = $self->scheme) {
+ return $self unless $URI::ABS_ALLOW_RELATIVE_SCHEME;
+ $base = URI->new($base) unless ref $base;
+ return $self unless $scheme eq $base->scheme;
+ }
+
+ $base = URI->new($base) unless ref $base;
+ my $abs = $self->clone;
+ $abs->scheme($base->scheme);
+ return $abs if $$self =~ m,^(?:$URI::scheme_re:)?//,o;
+ $abs->authority($base->authority);
+
+ my $path = $self->path;
+ return $abs if $path =~ m,^/,;
+
+ if (!length($path)) {
+ my $abs = $base->clone;
+ my $query = $self->query;
+ $abs->query($query) if defined $query;
+ my $fragment = $self->fragment;
+ $abs->fragment($fragment) if defined $fragment;
+ return $abs;
+ }
+
+ my $p = $base->path;
+ $p =~ s,[^/]+$,,;
+ $p .= $path;
+ my @p = split('/', $p, -1);
+ shift(@p) if @p && !length($p[0]);
+ my $i = 1;
+ while ($i < @p) {
+ #print "$i ", join("/", @p), " ($p[$i])\n";
+ if ($p[$i-1] eq ".") {
+ splice(@p, $i-1, 1);
+ $i-- if $i > 1;
+ }
+ elsif ($p[$i] eq ".." && $p[$i-1] ne "..") {
+ splice(@p, $i-1, 2);
+ if ($i > 1) {
+ $i--;
+ push(@p, "") if $i == @p;
+ }
+ }
+ else {
+ $i++;
+ }
+ }
+ $p[-1] = "" if @p && $p[-1] eq "."; # trailing "/."
+ if ($URI::ABS_REMOTE_LEADING_DOTS) {
+ shift @p while @p && $p[0] =~ /^\.\.?$/;
+ }
+ $abs->path("/" . join("/", @p));
+ $abs;
+}
+
+# The opposite of $url->abs. Return a URI which is as relative as possible
+sub rel {
+ my $self = shift;
+ my $base = shift || Carp::croak("Missing base argument");
+ my $rel = $self->clone;
+ $base = URI->new($base) unless ref $base;
+
+ #my($scheme, $auth, $path) = @{$rel}{qw(scheme authority path)};
+ my $scheme = $rel->scheme;
+ my $auth = $rel->canonical->authority;
+ my $path = $rel->path;
+
+ if (!defined($scheme) && !defined($auth)) {
+ # it is already relative
+ return $rel;
+ }
+
+ #my($bscheme, $bauth, $bpath) = @{$base}{qw(scheme authority path)};
+ my $bscheme = $base->scheme;
+ my $bauth = $base->canonical->authority;
+ my $bpath = $base->path;
+
+ for ($bscheme, $bauth, $auth) {
+ $_ = '' unless defined
+ }
+
+ unless ($scheme eq $bscheme && $auth eq $bauth) {
+ # different location, can't make it relative
+ return $rel;
+ }
+
+ for ($path, $bpath) { $_ = "/$_" unless m,^/,; }
+
+ # Make it relative by eliminating scheme and authority
+ $rel->scheme(undef);
+ $rel->authority(undef);
+
+ # This loop is based on code from Nicolai Langfeldt <janl@ifi.uio.no>.
+ # First we calculate common initial path components length ($li).
+ my $li = 1;
+ while (1) {
+ my $i = index($path, '/', $li);
+ last if $i < 0 ||
+ $i != index($bpath, '/', $li) ||
+ substr($path,$li,$i-$li) ne substr($bpath,$li,$i-$li);
+ $li=$i+1;
+ }
+ # then we nuke it from both paths
+ substr($path, 0,$li) = '';
+ substr($bpath,0,$li) = '';
+
+ if ($path eq $bpath &&
+ defined($rel->fragment) &&
+ !defined($rel->query)) {
+ $rel->path("");
+ }
+ else {
+ # Add one "../" for each path component left in the base path
+ $path = ('../' x $bpath =~ tr|/|/|) . $path;
+ $path = "./" if $path eq "";
+ $rel->path($path);
+ }
+
+ $rel;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm
new file mode 100644
index 0000000000..8392e107d9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_idna.pm
@@ -0,0 +1,91 @@
+package URI::_idna;
+
+# This module implements the RFCs 3490 (IDNA) and 3491 (Nameprep)
+# based on Python-2.6.4/Lib/encodings/idna.py
+
+use strict;
+use warnings;
+
+use URI::_punycode qw(encode_punycode decode_punycode);
+use Carp qw(croak);
+
+our $VERSION = '1.76';
+
+BEGIN {
+ *URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS = "$]" < 5.008_003
+ ? sub () { 1 }
+ : sub () { 0 }
+ ;
+}
+
+my $ASCII = qr/^[\x00-\x7F]*\z/;
+
+sub encode {
+ my $idomain = shift;
+ my @labels = split(/\./, $idomain, -1);
+ my @last_empty;
+ push(@last_empty, pop @labels) if @labels > 1 && $labels[-1] eq "";
+ for (@labels) {
+ $_ = ToASCII($_);
+ }
+
+ return eval 'join(".", @labels, @last_empty)' if URI::_idna::_ENV_::JOIN_LEAKS_UTF8_FLAGS;
+ return join(".", @labels, @last_empty);
+}
+
+sub decode {
+ my $domain = shift;
+ return join(".", map ToUnicode($_), split(/\./, $domain, -1))
+}
+
+sub nameprep { # XXX real implementation missing
+ my $label = shift;
+ $label = lc($label);
+ return $label;
+}
+
+sub check_size {
+ my $label = shift;
+ croak "Label empty" if $label eq "";
+ croak "Label too long" if length($label) > 63;
+ return $label;
+}
+
+sub ToASCII {
+ my $label = shift;
+ return check_size($label) if $label =~ $ASCII;
+
+ # Step 2: nameprep
+ $label = nameprep($label);
+ # Step 3: UseSTD3ASCIIRules is false
+ # Step 4: try ASCII again
+ return check_size($label) if $label =~ $ASCII;
+
+ # Step 5: Check ACE prefix
+ if ($label =~ /^xn--/) {
+ croak "Label starts with ACE prefix";
+ }
+
+ # Step 6: Encode with PUNYCODE
+ $label = encode_punycode($label);
+
+ # Step 7: Prepend ACE prefix
+ $label = "xn--$label";
+
+ # Step 8: Check size
+ return check_size($label);
+}
+
+sub ToUnicode {
+ my $label = shift;
+ $label = nameprep($label) unless $label =~ $ASCII;
+ return $label unless $label =~ /^xn--/;
+ my $result = decode_punycode(substr($label, 4));
+ my $label2 = ToASCII($result);
+ if (lc($label) ne $label2) {
+ croak "IDNA does not round-trip: '\L$label\E' vs '$label2'";
+ }
+ return $result;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm
new file mode 100644
index 0000000000..5057c37cb3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_ldap.pm
@@ -0,0 +1,140 @@
+# Copyright (c) 1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package URI::_ldap;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use URI::Escape qw(uri_unescape);
+
+sub _ldap_elem {
+ my $self = shift;
+ my $elem = shift;
+ my $query = $self->query;
+ my @bits = (split(/\?/,defined($query) ? $query : ""),("")x4);
+ my $old = $bits[$elem];
+
+ if (@_) {
+ my $new = shift;
+ $new =~ s/\?/%3F/g;
+ $bits[$elem] = $new;
+ $query = join("?",@bits);
+ $query =~ s/\?+$//;
+ $query = undef unless length($query);
+ $self->query($query);
+ }
+
+ $old;
+}
+
+sub dn {
+ my $old = shift->path(@_);
+ $old =~ s:^/::;
+ uri_unescape($old);
+}
+
+sub attributes {
+ my $self = shift;
+ my $old = _ldap_elem($self,0, @_ ? join(",", map { my $tmp = $_; $tmp =~ s/,/%2C/g; $tmp } @_) : ());
+ return $old unless wantarray;
+ map { uri_unescape($_) } split(/,/,$old);
+}
+
+sub _scope {
+ my $self = shift;
+ my $old = _ldap_elem($self,1, @_);
+ return undef unless defined wantarray && defined $old;
+ uri_unescape($old);
+}
+
+sub scope {
+ my $old = &_scope;
+ $old = "base" unless length $old;
+ $old;
+}
+
+sub _filter {
+ my $self = shift;
+ my $old = _ldap_elem($self,2, @_);
+ return undef unless defined wantarray && defined $old;
+ uri_unescape($old); # || "(objectClass=*)";
+}
+
+sub filter {
+ my $old = &_filter;
+ $old = "(objectClass=*)" unless length $old;
+ $old;
+}
+
+sub extensions {
+ my $self = shift;
+ my @ext;
+ while (@_) {
+ my $key = shift;
+ my $value = shift;
+ push(@ext, join("=", map { $_="" unless defined; s/,/%2C/g; $_ } $key, $value));
+ }
+ @ext = join(",", @ext) if @ext;
+ my $old = _ldap_elem($self,3, @ext);
+ return $old unless wantarray;
+ map { uri_unescape($_) } map { /^([^=]+)=(.*)$/ } split(/,/,$old);
+}
+
+sub canonical
+{
+ my $self = shift;
+ my $other = $self->_nonldap_canonical;
+
+ # The stuff below is not as efficient as one might hope...
+
+ $other = $other->clone if $other == $self;
+
+ $other->dn(_normalize_dn($other->dn));
+
+ # Should really know about mixed case "postalAddress", etc...
+ $other->attributes(map lc, $other->attributes);
+
+ # Lowercase scope, remove default
+ my $old_scope = $other->scope;
+ my $new_scope = lc($old_scope);
+ $new_scope = "" if $new_scope eq "base";
+ $other->scope($new_scope) if $new_scope ne $old_scope;
+
+ # Remove filter if default
+ my $old_filter = $other->filter;
+ $other->filter("") if lc($old_filter) eq "(objectclass=*)" ||
+ lc($old_filter) eq "objectclass=*";
+
+ # Lowercase extensions types and deal with known extension values
+ my @ext = $other->extensions;
+ for (my $i = 0; $i < @ext; $i += 2) {
+ my $etype = $ext[$i] = lc($ext[$i]);
+ if ($etype =~ /^!?bindname$/) {
+ $ext[$i+1] = _normalize_dn($ext[$i+1]);
+ }
+ }
+ $other->extensions(@ext) if @ext;
+
+ $other;
+}
+
+sub _normalize_dn # RFC 2253
+{
+ my $dn = shift;
+
+ return $dn;
+ # The code below will fail if the "+" or "," is embedding in a quoted
+ # string or simply escaped...
+
+ my @dn = split(/([+,])/, $dn);
+ for (@dn) {
+ s/^([a-zA-Z]+=)/lc($1)/e;
+ }
+ join("", @dn);
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm
new file mode 100644
index 0000000000..7c3e5a1b83
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_login.pm
@@ -0,0 +1,13 @@
+package URI::_login;
+
+use strict;
+use warnings;
+
+use parent qw(URI::_server URI::_userpass);
+
+our $VERSION = '1.76';
+
+# Generic terminal logins. This is used as a base class for 'telnet',
+# 'tn3270', and 'rlogin' URL schemes.
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm
new file mode 100644
index 0000000000..405acc2de1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_punycode.pm
@@ -0,0 +1,217 @@
+package URI::_punycode;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use Exporter 'import';
+our @EXPORT = qw(encode_punycode decode_punycode);
+
+use integer;
+
+our $DEBUG = 0;
+
+use constant BASE => 36;
+use constant TMIN => 1;
+use constant TMAX => 26;
+use constant SKEW => 38;
+use constant DAMP => 700;
+use constant INITIAL_BIAS => 72;
+use constant INITIAL_N => 128;
+
+my $Delimiter = chr 0x2D;
+my $BasicRE = qr/[\x00-\x7f]/;
+
+sub _croak { require Carp; Carp::croak(@_); }
+
+sub digit_value {
+ my $code = shift;
+ return ord($code) - ord("A") if $code =~ /[A-Z]/;
+ return ord($code) - ord("a") if $code =~ /[a-z]/;
+ return ord($code) - ord("0") + 26 if $code =~ /[0-9]/;
+ return;
+}
+
+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 {
+ my($delta, $numpoints, $firsttime) = @_;
+ $delta = $firsttime ? $delta / DAMP : $delta / 2;
+ $delta += $delta / $numpoints;
+ my $k = 0;
+ while ($delta > ((BASE - TMIN) * TMAX) / 2) {
+ $delta /= BASE - TMIN;
+ $k += BASE;
+ }
+ return $k + (((BASE - TMIN + 1) * $delta) / ($delta + SKEW));
+}
+
+sub decode_punycode {
+ my $code = shift;
+
+ my $n = INITIAL_N;
+ my $i = 0;
+ my $bias = INITIAL_BIAS;
+ my @output;
+
+ if ($code =~ s/(.*)$Delimiter//o) {
+ push @output, map ord, split //, $1;
+ return _croak('non-basic code point') unless $1 =~ /^$BasicRE*$/o;
+ }
+
+ while ($code) {
+ my $oldi = $i;
+ my $w = 1;
+ LOOP:
+ for (my $k = BASE; 1; $k += BASE) {
+ my $cp = substr($code, 0, 1, '');
+ my $digit = digit_value($cp);
+ defined $digit or return _croak("invalid punycode input");
+ $i += $digit * $w;
+ my $t = ($k <= $bias) ? TMIN
+ : ($k >= $bias + TMAX) ? TMAX : $k - $bias;
+ last LOOP if $digit < $t;
+ $w *= (BASE - $t);
+ }
+ $bias = adapt($i - $oldi, @output + 1, $oldi == 0);
+ warn "bias becomes $bias" if $DEBUG;
+ $n += $i / (@output + 1);
+ $i = $i % (@output + 1);
+ splice(@output, $i, 0, $n);
+ warn join " ", map sprintf('%04x', $_), @output if $DEBUG;
+ $i++;
+ }
+ return join '', map chr, @output;
+}
+
+sub encode_punycode {
+ my $input = shift;
+ my @input = split //, $input;
+
+ my $n = INITIAL_N;
+ my $delta = 0;
+ my $bias = INITIAL_BIAS;
+
+ my @output;
+ my @basic = grep /$BasicRE/, @input;
+ my $h = my $b = @basic;
+ push @output, @basic;
+ push @output, $Delimiter if $b && $h < @input;
+ warn "basic codepoints: (@output)" if $DEBUG;
+
+ while ($h < @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;
+ for my $i (@input) {
+ my $c = ord($i);
+ $delta++ if $c < $n;
+ if ($c == $n) {
+ my $q = $delta;
+ LOOP:
+ for (my $k = BASE; 1; $k += BASE) {
+ 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)));
+ push @output, chr($cp);
+ $q = ($q - $t) / (BASE - $t);
+ }
+ push @output, chr(code_point($q));
+ $bias = adapt($delta, $h + 1, $h == $b);
+ warn "bias becomes $bias" if $DEBUG;
+ $delta = 0;
+ $h++;
+ }
+ }
+ $delta++;
+ $n++;
+ }
+ return join '', @output;
+}
+
+sub min {
+ my $min = shift;
+ for (@_) { $min = $_ if $_ <= $min }
+ return $min;
+}
+
+1;
+__END__
+
+=encoding utf8
+
+=head1 NAME
+
+URI::_punycode - encodes Unicode string in Punycode
+
+=head1 SYNOPSIS
+
+ use strict;
+ use warnings;
+ use utf8;
+
+ use URI::_punycode qw(encode_punycode decode_punycode);
+
+ # encode a unicode string
+ my $punycode = encode_punycode('http://☃.net'); # http://.net-xc8g
+ $punycode = encode_punycode('bücher'); # bcher-kva
+ $punycode = encode_punycode('他们为什么ä¸è¯´ä¸­æ–‡'); # ihqwcrb4cv8a8dqg056pqjye
+
+ # decode a punycode string back into a unicode string
+ my $unicode = decode_punycode('http://.net-xc8g'); # http://☃.net
+ $unicode = decode_punycode('bcher-kva'); # bücher
+ $unicode = decode_punycode('ihqwcrb4cv8a8dqg056pqjye'); # 他们为什么ä¸è¯´ä¸­æ–‡
+
+=head1 DESCRIPTION
+
+L<URI::_punycode> is a module to encode / decode Unicode strings into
+L<Punycode|https://tools.ietf.org/html/rfc3492>, an efficient
+encoding of Unicode for use with L<IDNA|https://tools.ietf.org/html/rfc5890>.
+
+=head1 FUNCTIONS
+
+All functions throw exceptions on failure. You can C<catch> them with
+L<Syntax::Keyword::Try> or L<Try::Tiny>. The following functions are exported
+by default.
+
+=head2 encode_punycode
+
+ my $punycode = encode_punycode('http://☃.net'); # http://.net-xc8g
+ $punycode = encode_punycode('bücher'); # bcher-kva
+ $punycode = encode_punycode('他们为什么ä¸è¯´ä¸­æ–‡') # ihqwcrb4cv8a8dqg056pqjye
+
+Takes a Unicode string (UTF8-flagged variable) and returns a Punycode
+encoding for it.
+
+=head2 decode_punycode
+
+ my $unicode = decode_punycode('http://.net-xc8g'); # http://☃.net
+ $unicode = decode_punycode('bcher-kva'); # bücher
+ $unicode = decode_punycode('ihqwcrb4cv8a8dqg056pqjye'); # 他们为什么ä¸è¯´ä¸­æ–‡
+
+Takes a Punycode encoding and returns original Unicode string.
+
+=head1 AUTHOR
+
+Tatsuhiko Miyagawa <F<miyagawa@bulknews.net>> is the author of
+L<IDNA::Punycode> which was the basis for this module.
+
+=head1 SEE ALSO
+
+L<IDNA::Punycode>, L<RFC 3492|https://tools.ietf.org/html/rfc3492>,
+L<RFC 5891|https://tools.ietf.org/html/rfc5891>
+
+=head1 COPYRIGHT AND LICENSE
+
+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/URI/_query.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm
new file mode 100644
index 0000000000..d9dde133e3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_query.pm
@@ -0,0 +1,97 @@
+package URI::_query;
+
+use strict;
+use warnings;
+
+use URI ();
+use URI::Escape qw(uri_unescape);
+
+our $VERSION = '1.76';
+
+sub query
+{
+ my $self = shift;
+ $$self =~ m,^([^?\#]*)(?:\?([^\#]*))?(.*)$,s or die;
+
+ if (@_) {
+ my $q = shift;
+ $$self = $1;
+ if (defined $q) {
+ $q =~ s/([^$URI::uric])/ URI::Escape::escape_char($1)/ego;
+ utf8::downgrade($q);
+ $$self .= "?$q";
+ }
+ $$self .= $3;
+ }
+ $2;
+}
+
+# Handle ...?foo=bar&bar=foo type of query
+sub query_form {
+ my $self = shift;
+ my $old = $self->query;
+ if (@_) {
+ # Try to set query string
+ my $delim;
+ my $r = $_[0];
+ if (ref($r) eq "ARRAY") {
+ $delim = $_[1];
+ @_ = @$r;
+ }
+ elsif (ref($r) eq "HASH") {
+ $delim = $_[1];
+ @_ = map { $_ => $r->{$_} } sort keys %$r;
+ }
+ $delim = pop if @_ % 2;
+
+ my @query;
+ while (my($key,$vals) = splice(@_, 0, 2)) {
+ $key = '' unless defined $key;
+ $key =~ s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg;
+ $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 (@query) {
+ unless ($delim) {
+ $delim = $1 if $old && $old =~ /([&;])/;
+ $delim ||= $URI::DEFAULT_QUERY_FORM_DELIMITER || "&";
+ }
+ $self->query(join($delim, @query));
+ }
+ else {
+ $self->query(undef);
+ }
+ }
+ return if !defined($old) || !length($old) || !defined(wantarray);
+ return unless $old =~ /=/; # not a form
+ map { s/\+/ /g; uri_unescape($_) }
+ map { /=/ ? split(/=/, $_, 2) : ($_ => '')} split(/[&;]/, $old);
+}
+
+# Handle ...?dog+bones type of query
+sub query_keywords
+{
+ my $self = shift;
+ my $old = $self->query;
+ if (@_) {
+ # Try to set query string
+ my @copy = @_;
+ @copy = @{$copy[0]} if @copy == 1 && ref($copy[0]) eq "ARRAY";
+ for (@copy) { s/([;\/?:@&=+,\$\[\]%])/ URI::Escape::escape_char($1)/eg; }
+ $self->query(@copy ? join('+', @copy) : undef);
+ }
+ return if !defined($old) || !defined(wantarray);
+ return if $old =~ /=/; # not keywords, but a form
+ map { uri_unescape($_) } split(/\+/, $old, -1);
+}
+
+# Some URI::URL compatibility stuff
+sub equery { goto &query }
+
+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
new file mode 100644
index 0000000000..01f207feb1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_segment.pm
@@ -0,0 +1,24 @@
+package URI::_segment;
+
+# Represents a generic path_segment so that it can be treated as
+# a string too.
+
+use strict;
+use warnings;
+
+use URI::Escape qw(uri_unescape);
+
+use overload '""' => sub { $_[0]->[0] },
+ fallback => 1;
+
+our $VERSION = '1.76';
+
+sub new
+{
+ my $class = shift;
+ my @segment = split(';', shift, -1);
+ $segment[0] = uri_unescape($segment[0]);
+ bless \@segment, $class;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm
new file mode 100644
index 0000000000..5c32400d17
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_server.pm
@@ -0,0 +1,166 @@
+package URI::_server;
+
+use strict;
+use warnings;
+
+use parent 'URI::_generic';
+
+use URI::Escape qw(uri_unescape);
+
+our $VERSION = '1.76';
+
+sub _uric_escape {
+ my($class, $str) = @_;
+ if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
+ my($scheme, $host, $rest) = ($1, $2, $3);
+ my $ui = $host =~ s/(.*@)// ? $1 : "";
+ my $port = $host =~ s/(:\d+)\z// ? $1 : "";
+ if (_host_escape($host)) {
+ $str = "$scheme//$ui$host$port$rest";
+ }
+ }
+ return $class->SUPER::_uric_escape($str);
+}
+
+sub _host_escape {
+ return unless $_[0] =~ /[^$URI::uric]/;
+ eval {
+ require URI::_idna;
+ $_[0] = URI::_idna::encode($_[0]);
+ };
+ return 0 if $@;
+ return 1;
+}
+
+sub as_iri {
+ my $self = shift;
+ my $str = $self->SUPER::as_iri;
+ if ($str =~ /\bxn--/) {
+ if ($str =~ m,^((?:$URI::scheme_re:)?)//([^/?\#]*)(.*)$,os) {
+ my($scheme, $host, $rest) = ($1, $2, $3);
+ my $ui = $host =~ s/(.*@)// ? $1 : "";
+ my $port = $host =~ s/(:\d+)\z// ? $1 : "";
+ require URI::_idna;
+ $host = URI::_idna::decode($host);
+ $str = "$scheme//$ui$host$port$rest";
+ }
+ }
+ return $str;
+}
+
+sub userinfo
+{
+ my $self = shift;
+ my $old = $self->authority;
+
+ if (@_) {
+ my $new = $old;
+ $new = "" unless defined $new;
+ $new =~ s/.*@//; # remove old stuff
+ my $ui = shift;
+ if (defined $ui) {
+ $ui =~ s/@/%40/g; # protect @
+ $new = "$ui\@$new";
+ }
+ $self->authority($new);
+ }
+ return undef if !defined($old) || $old !~ /(.*)@/;
+ return $1;
+}
+
+sub host
+{
+ my $self = shift;
+ my $old = $self->authority;
+ if (@_) {
+ my $tmp = $old;
+ $tmp = "" unless defined $tmp;
+ my $ui = ($tmp =~ /(.*@)/) ? $1 : "";
+ my $port = ($tmp =~ /(:\d+)$/) ? $1 : "";
+ my $new = shift;
+ $new = "" unless defined $new;
+ if (length $new) {
+ $new =~ s/[@]/%40/g; # protect @
+ if ($new =~ /^[^:]*:\d*\z/ || $new =~ /]:\d*\z/) {
+ $new =~ s/(:\d*)\z// || die "Assert";
+ $port = $1;
+ }
+ $new = "[$new]" if $new =~ /:/ && $new !~ /^\[/; # IPv6 address
+ _host_escape($new);
+ }
+ $self->authority("$ui$new$port");
+ }
+ return undef unless defined $old;
+ $old =~ s/.*@//;
+ $old =~ s/:\d+$//; # remove the port
+ $old =~ s{^\[(.*)\]$}{$1}; # remove brackets around IPv6 (RFC 3986 3.2.2)
+ return uri_unescape($old);
+}
+
+sub ihost
+{
+ my $self = shift;
+ my $old = $self->host(@_);
+ if ($old =~ /(^|\.)xn--/) {
+ require URI::_idna;
+ $old = URI::_idna::decode($old);
+ }
+ return $old;
+}
+
+sub _port
+{
+ my $self = shift;
+ my $old = $self->authority;
+ if (@_) {
+ my $new = $old;
+ $new =~ s/:\d*$//;
+ my $port = shift;
+ $new .= ":$port" if defined $port;
+ $self->authority($new);
+ }
+ return $1 if defined($old) && $old =~ /:(\d*)$/;
+ return;
+}
+
+sub port
+{
+ my $self = shift;
+ my $port = $self->_port(@_);
+ $port = $self->default_port if !defined($port) || $port eq "";
+ $port;
+}
+
+sub host_port
+{
+ my $self = shift;
+ my $old = $self->authority;
+ $self->host(shift) if @_;
+ return undef unless defined $old;
+ $old =~ s/.*@//; # zap userinfo
+ $old =~ s/:$//; # empty port should be treated the same a no port
+ $old .= ":" . $self->port unless $old =~ /:\d+$/;
+ $old;
+}
+
+
+sub default_port { undef }
+
+sub canonical
+{
+ my $self = shift;
+ my $other = $self->SUPER::canonical;
+ my $host = $other->host || "";
+ my $port = $other->_port;
+ my $uc_host = $host =~ /[A-Z]/;
+ my $def_port = defined($port) && ($port eq "" ||
+ $port == $self->default_port);
+ if ($uc_host || $def_port) {
+ $other = $other->clone if $other == $self;
+ $other->host(lc $host) if $uc_host;
+ $other->port(undef) if $def_port;
+ }
+ $other;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm
new file mode 100644
index 0000000000..b57fb2a502
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/_userpass.pm
@@ -0,0 +1,55 @@
+package URI::_userpass;
+
+use strict;
+use warnings;
+
+use URI::Escape qw(uri_unescape);
+
+our $VERSION = '1.76';
+
+sub user
+{
+ my $self = shift;
+ my $info = $self->userinfo;
+ if (@_) {
+ my $new = shift;
+ my $pass = defined($info) ? $info : "";
+ $pass =~ s/^[^:]*//;
+
+ if (!defined($new) && !length($pass)) {
+ $self->userinfo(undef);
+ } else {
+ $new = "" unless defined($new);
+ $new =~ s/%/%25/g;
+ $new =~ s/:/%3A/g;
+ $self->userinfo("$new$pass");
+ }
+ }
+ return undef unless defined $info;
+ $info =~ s/:.*//;
+ uri_unescape($info);
+}
+
+sub password
+{
+ my $self = shift;
+ my $info = $self->userinfo;
+ if (@_) {
+ my $new = shift;
+ my $user = defined($info) ? $info : "";
+ $user =~ s/:.*//;
+
+ if (!defined($new) && !length($user)) {
+ $self->userinfo(undef);
+ } else {
+ $new = "" unless defined($new);
+ $new =~ s/%/%25/g;
+ $self->userinfo("$user:$new");
+ }
+ }
+ return undef unless defined $info;
+ return undef unless $info =~ s/^[^:]*://;
+ uri_unescape($info);
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm
new file mode 100644
index 0000000000..b21b5a31a0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/data.pm
@@ -0,0 +1,142 @@
+package URI::data; # RFC 2397
+
+use strict;
+use warnings;
+
+use parent 'URI';
+
+our $VERSION = '1.76';
+
+use MIME::Base64 qw(encode_base64 decode_base64);
+use URI::Escape qw(uri_unescape);
+
+sub media_type
+{
+ my $self = shift;
+ my $opaque = $self->opaque;
+ $opaque =~ /^([^,]*),?/ or die;
+ my $old = $1;
+ my $base64;
+ $base64 = $1 if $old =~ s/(;base64)$//i;
+ if (@_) {
+ my $new = shift;
+ $new = "" unless defined $new;
+ $new =~ s/%/%25/g;
+ $new =~ s/,/%2C/g;
+ $base64 = "" unless defined $base64;
+ $opaque =~ s/^[^,]*,?/$new$base64,/;
+ $self->opaque($opaque);
+ }
+ return uri_unescape($old) if $old; # media_type can't really be "0"
+ "text/plain;charset=US-ASCII"; # default type
+}
+
+sub data
+{
+ my $self = shift;
+ my($enc, $data) = split(",", $self->opaque, 2);
+ unless (defined $data) {
+ $data = "";
+ $enc = "" unless defined $enc;
+ }
+ my $base64 = ($enc =~ /;base64$/i);
+ if (@_) {
+ $enc =~ s/;base64$//i if $base64;
+ my $new = shift;
+ $new = "" unless defined $new;
+ my $uric_count = _uric_count($new);
+ my $urienc_len = $uric_count + (length($new) - $uric_count) * 3;
+ my $base64_len = int((length($new)+2) / 3) * 4;
+ $base64_len += 7; # because of ";base64" marker
+ if ($base64_len < $urienc_len || $_[0]) {
+ $enc .= ";base64";
+ $new = encode_base64($new, "");
+ } else {
+ $new =~ s/%/%25/g;
+ }
+ $self->opaque("$enc,$new");
+ }
+ return unless defined wantarray;
+ $data = uri_unescape($data);
+ return $base64 ? decode_base64($data) : $data;
+}
+
+# I could not find a better way to interpolate the tr/// chars from
+# a variable.
+my $ENC = $URI::uric;
+$ENC =~ s/%//;
+
+eval <<EOT; die $@ if $@;
+sub _uric_count
+{
+ \$_[0] =~ tr/$ENC//;
+}
+EOT
+
+1;
+
+__END__
+
+=head1 NAME
+
+URI::data - URI that contains immediate data
+
+=head1 SYNOPSIS
+
+ use URI;
+
+ $u = URI->new("data:");
+ $u->media_type("image/gif");
+ $u->data(scalar(`cat camel.gif`));
+ print "$u\n";
+ open(XV, "|xv -") and print XV $u->data;
+
+=head1 DESCRIPTION
+
+The C<URI::data> class supports C<URI> objects belonging to the I<data>
+URI scheme. The I<data> URI scheme is specified in RFC 2397. It
+allows inclusion of small data items as "immediate" data, as if it had
+been included externally. Examples:
+
+ data:,Perl%20is%20good
+
+ data:image/gif;base64,R0lGODdhIAAgAIAAAAAAAPj8+CwAAAAAI
+ AAgAAAClYyPqcu9AJyCjtIKc5w5xP14xgeO2tlY3nWcajmZZdeJcG
+ Kxrmimms1KMTa1Wg8UROx4MNUq1HrycMjHT9b6xKxaFLM6VRKzI+p
+ KS9XtXpcbdun6uWVxJXA8pNPkdkkxhxc21LZHFOgD2KMoQXa2KMWI
+ JtnE2KizVUkYJVZZ1nczBxXlFopZBtoJ2diXGdNUymmJdFMAADs=
+
+
+
+C<URI> objects belonging to the data scheme support the common methods
+(described in L<URI>) and the following two scheme-specific methods:
+
+=over 4
+
+=item $uri->media_type( [$new_media_type] )
+
+Can be used to get or set the media type specified in the
+URI. If no media type is specified, then the default
+C<"text/plain;charset=US-ASCII"> is returned.
+
+=item $uri->data( [$new_data] )
+
+Can be used to get or set the data contained in the URI.
+The data is passed unescaped (in binary form). The decision about
+whether to base64 encode the data in the URI is taken automatically,
+based on the encoding that produces the shorter URI string.
+
+=back
+
+=head1 SEE ALSO
+
+L<URI>
+
+=head1 COPYRIGHT
+
+Copyright 1995-1998 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/URI/file.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm
new file mode 100644
index 0000000000..d76ddf2b5e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file.pm
@@ -0,0 +1,327 @@
+package URI::file;
+
+use strict;
+use warnings;
+
+use parent 'URI::_generic';
+our $VERSION = "4.21";
+
+use URI::Escape qw(uri_unescape);
+
+our $DEFAULT_AUTHORITY = "";
+
+# Map from $^O values to implementation classes. The Unix
+# class is the default.
+our %OS_CLASS = (
+ os2 => "OS2",
+ mac => "Mac",
+ MacOS => "Mac",
+ MSWin32 => "Win32",
+ win32 => "Win32",
+ msdos => "FAT",
+ dos => "FAT",
+ qnx => "QNX",
+);
+
+sub os_class
+{
+ my($OS) = shift || $^O;
+
+ my $class = "URI::file::" . ($OS_CLASS{$OS} || "Unix");
+ no strict 'refs';
+ unless (%{"$class\::"}) {
+ eval "require $class";
+ die $@ if $@;
+ }
+ $class;
+}
+
+sub host { uri_unescape(shift->authority(@_)) }
+
+sub new
+{
+ my($class, $path, $os) = @_;
+ os_class($os)->new($path);
+}
+
+sub new_abs
+{
+ my $class = shift;
+ my $file = $class->new(@_);
+ return $file->abs($class->cwd) unless $$file =~ /^file:/;
+ $file;
+}
+
+sub cwd
+{
+ my $class = shift;
+ require Cwd;
+ my $cwd = Cwd::cwd();
+ $cwd = VMS::Filespec::unixpath($cwd) if $^O eq 'VMS';
+ $cwd = $class->new($cwd);
+ $cwd .= "/" unless substr($cwd, -1, 1) eq "/";
+ $cwd;
+}
+
+sub canonical {
+ my $self = shift;
+ my $other = $self->SUPER::canonical;
+
+ my $scheme = $other->scheme;
+ my $auth = $other->authority;
+ return $other if !defined($scheme) && !defined($auth); # relative
+
+ if (!defined($auth) ||
+ $auth eq "" ||
+ lc($auth) eq "localhost" ||
+ (defined($DEFAULT_AUTHORITY) && lc($auth) eq lc($DEFAULT_AUTHORITY))
+ )
+ {
+ # avoid cloning if $auth already match
+ if ((defined($auth) || defined($DEFAULT_AUTHORITY)) &&
+ (!defined($auth) || !defined($DEFAULT_AUTHORITY) || $auth ne $DEFAULT_AUTHORITY)
+ )
+ {
+ $other = $other->clone if $self == $other;
+ $other->authority($DEFAULT_AUTHORITY);
+ }
+ }
+
+ $other;
+}
+
+sub file
+{
+ my($self, $os) = @_;
+ os_class($os)->file($self);
+}
+
+sub dir
+{
+ my($self, $os) = @_;
+ os_class($os)->dir($self);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+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");
+
+=head1 DESCRIPTION
+
+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.
+
+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>
+URI objects from the actual file names used by various systems, then
+use one of the following C<URI::file> constructors:
+
+=over 4
+
+=item $u = URI::file->new( $filename, [$os] )
+
+Maps a file name to the I<file:> URI name space, creates a URI object
+and returns it. The $filename is interpreted as belonging to the
+indicated operating system ($os), which defaults to the value of the
+$^O variable. The $filename can be either absolute or relative, and
+the corresponding type of URI object for $os is returned.
+
+=item $u = URI::file->new_abs( $filename, [$os] )
+
+Same as URI::file->new, but makes sure that the URI returned
+represents an absolute file name. If the $filename argument is
+relative, then the name is resolved relative to the current directory,
+i.e. this constructor is really the same as:
+
+ URI::file->new($filename)->abs(URI::file->cwd);
+
+=item $u = URI::file->cwd
+
+Returns a I<file> URI that represents the current working directory.
+See L<Cwd>.
+
+=back
+
+The following methods are supported for I<file> URI (in addition to
+the common and generic methods described in L<URI>):
+
+=over 4
+
+=item $u->file( [$os] )
+
+Returns a file name. It maps from the URI name space
+to the file name space of the indicated operating system.
+
+It might return C<undef> if the name can not be represented in the
+indicated file system.
+
+=item $u->dir( [$os] )
+
+Some systems use a different form for names of directories than for plain
+files. Use this method if you know you want to use the name for
+a directory.
+
+=back
+
+The C<URI::file> module can be used to map generic file names to names
+suitable for the current system. As such, it can work as a nice
+replacement for the C<File::Spec> module. For instance, the following
+code translates the UNIX-style file name F<Foo/Bar.pm> to a name
+suitable for the local system:
+
+ $file = URI::file->new("Foo/Bar.pm", "unix")->file;
+ die "Can't map filename Foo/Bar.pm for $^O" unless defined $file;
+ open(FILE, $file) || die "Can't open '$file': $!";
+ # do something with FILE
+
+=head1 MAPPING NOTES
+
+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
+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
+different meaning than what is specified for generic URIs, then these
+must be encoded as well.
+
+If the file system has device, volume or drive specifications as
+the root of the name space, then it makes sense to map them to the
+authority field of the generic URI syntax. This makes sure that
+relative URIs can not be resolved "above" them, i.e. generally how
+relative file names work in those systems.
+
+Another common use of the authority field is to encode the host on which
+this file name is valid. The host name "localhost" is special and
+generally has the same meaning as a missing or empty authority
+field. This use is in conflict with using it as a device
+specification, but can often be resolved for device specifications
+having characters not legal in plain host names.
+
+File name to URI mapping in normally not one-to-one. There are
+usually many URIs that map to any given file name. For instance, an
+authority of "localhost" maps the same as a URI with a missing or empty
+authority.
+
+Example 1: The Mac classic (Mac OS 9 and earlier) used ":" as path separator,
+but not in the same way as a generic URI. ":foo" was a relative name. "foo:bar"
+was an absolute name. Also, path segments could contain the "/" character as well
+as the literal "." or "..". So the mapping looks like this:
+
+ Mac classic URI
+ ---------- -------------------
+ :foo:bar <==> foo/bar
+ : <==> ./
+ ::foo:bar <==> ../foo/bar
+ ::: <==> ../../
+ foo:bar <==> file:/foo/bar
+ foo:bar: <==> file:/foo/bar/
+ .. <==> %2E%2E
+ <undef> <== /
+ foo/ <== file:/foo%2F
+ ./foo.txt <== file:/.%2Ffoo.txt
+
+Note that if you want a relative URL, you *must* begin the path with a :. Any
+path that begins with [^:] is treated as absolute.
+
+Example 2: The UNIX file system is easy to map, as it uses the same path
+separator as URIs, has a single root, and segments of "." and ".."
+have the same meaning. URIs that have the character "\0" or "/" as
+part of any path segment can not be turned into valid UNIX file names.
+
+ UNIX URI
+ ---------- ------------------
+ foo/bar <==> foo/bar
+ /foo/bar <==> file:/foo/bar
+ /foo/bar <== file://localhost/foo/bar
+ file: ==> ./file:
+ <undef> <== file:/fo%00/bar
+ / <==> file:/
+
+=cut
+
+
+RFC 1630
+
+ [...]
+
+ There is clearly a danger of confusion that a link made to a local
+ file should be followed by someone on a different system, with
+ unexpected and possibly harmful results. Therefore, the convention
+ is that even a "file" URL is provided with a host part. This allows
+ a client on another system to know that it cannot access the file
+ system, or perhaps to use some other local mechanism to access the
+ file.
+
+ The special value "localhost" is used in the host field to indicate
+ that the filename should really be used on whatever host one is.
+ This for example allows links to be made to files which are
+ distributed on many machines, or to "your unix local password file"
+ subject of course to consistency across the users of the data.
+
+ A void host field is equivalent to "localhost".
+
+=head1 CONFIGURATION VARIABLES
+
+The following configuration variables influence how the class and its
+methods behave:
+
+=over
+
+=item %URI::file::OS_CLASS
+
+This hash maps OS identifiers to implementation classes. You might
+want to add or modify this if you want to plug in your own file
+handler class. Normally the keys should match the $^O values in use.
+
+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
+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
+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.
+
+=back
+
+
+=head1 SEE ALSO
+
+L<URI>, L<File::Spec>, L<perlport>
+
+=head1 COPYRIGHT
+
+Copyright 1995-1998,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/URI/file/Base.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm
new file mode 100644
index 0000000000..bddd78a44f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Base.pm
@@ -0,0 +1,84 @@
+package URI::file::Base;
+
+use strict;
+use warnings;
+
+use URI::Escape qw();
+
+our $VERSION = '1.76';
+
+sub new
+{
+ my $class = shift;
+ my $path = shift;
+ $path = "" unless defined $path;
+
+ my($auth, $escaped_auth, $escaped_path);
+
+ ($auth, $escaped_auth) = $class->_file_extract_authority($path);
+ ($path, $escaped_path) = $class->_file_extract_path($path);
+
+ if (defined $auth) {
+ $auth =~ s,%,%25,g unless $escaped_auth;
+ $auth =~ s,([/?\#]), URI::Escape::escape_char($1),eg;
+ $auth = "//$auth";
+ if (defined $path) {
+ $path = "/$path" unless substr($path, 0, 1) eq "/";
+ } else {
+ $path = "";
+ }
+ } else {
+ return undef unless defined $path;
+ $auth = "";
+ }
+
+ $path =~ s,([%;?]), URI::Escape::escape_char($1),eg unless $escaped_path;
+ $path =~ s/\#/%23/g;
+
+ my $uri = $auth . $path;
+ $uri = "file:$uri" if substr($uri, 0, 1) eq "/";
+
+ URI->new($uri, "file");
+}
+
+sub _file_extract_authority
+{
+ my($class, $path) = @_;
+ return undef unless $class->_file_is_absolute($path);
+ return $URI::file::DEFAULT_AUTHORITY;
+}
+
+sub _file_extract_path
+{
+ return undef;
+}
+
+sub _file_is_absolute
+{
+ return 0;
+}
+
+sub _file_is_localhost
+{
+ shift; # class
+ my $host = lc(shift);
+ return 1 if $host eq "localhost";
+ eval {
+ require Net::Domain;
+ lc(Net::Domain::hostfqdn() || '') eq $host ||
+ lc(Net::Domain::hostname() || '') eq $host;
+ };
+}
+
+sub file
+{
+ undef;
+}
+
+sub dir
+{
+ my $self = shift;
+ $self->file(@_);
+}
+
+1;
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
new file mode 100644
index 0000000000..78ed78002e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/FAT.pm
@@ -0,0 +1,27 @@
+package URI::file::FAT;
+
+use strict;
+use warnings;
+
+use parent 'URI::file::Win32';
+
+our $VERSION = '1.76';
+
+sub fix_path
+{
+ shift; # class
+ for (@_) {
+ # turn it into 8.3 names
+ my @p = map uc, split(/\./, $_, -1);
+ return if @p > 2; # more than 1 dot is not allowed
+ @p = ("") unless @p; # split bug? (returns nothing when splitting "")
+ $_ = substr($p[0], 0, 8);
+ if (@p > 1) {
+ my $ext = substr($p[1], 0, 3);
+ $_ .= ".$ext" if length $ext;
+ }
+ }
+ 1; # ok
+}
+
+1;
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
new file mode 100644
index 0000000000..155d618b42
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Mac.pm
@@ -0,0 +1,121 @@
+package URI::file::Mac;
+
+use strict;
+use warnings;
+
+use parent 'URI::file::Base';
+
+use URI::Escape qw(uri_unescape);
+
+our $VERSION = '1.76';
+
+sub _file_extract_path
+{
+ my $class = shift;
+ my $path = shift;
+
+ my @pre;
+ if ($path =~ s/^(:+)//) {
+ if (length($1) == 1) {
+ @pre = (".") unless length($path);
+ } else {
+ @pre = ("..") x (length($1) - 1);
+ }
+ } else { #absolute
+ $pre[0] = "";
+ }
+
+ my $isdir = ($path =~ s/:$//);
+ $path =~ s,([%/;]), URI::Escape::escape_char($1),eg;
+
+ my @path = split(/:/, $path, -1);
+ for (@path) {
+ if ($_ eq "." || $_ eq "..") {
+ $_ = "%2E" x length($_);
+ }
+ $_ = ".." unless length($_);
+ }
+ push (@path,"") if $isdir;
+ (join("/", @pre, @path), 1);
+}
+
+
+sub file
+{
+ my $class = shift;
+ my $uri = shift;
+ my @path;
+
+ my $auth = $uri->authority;
+ if (defined $auth) {
+ if (lc($auth) ne "localhost" && $auth ne "") {
+ my $u_auth = uri_unescape($auth);
+ if (!$class->_file_is_localhost($u_auth)) {
+ # some other host (use it as volume name)
+ @path = ("", $auth);
+ # XXX or just return to make it illegal;
+ }
+ }
+ }
+ my @ps = split("/", $uri->path, -1);
+ shift @ps if @path;
+ push(@path, @ps);
+
+ my $pre = "";
+ if (!@path) {
+ return; # empty path; XXX return ":" instead?
+ } elsif ($path[0] eq "") {
+ # absolute
+ shift(@path);
+ if (@path == 1) {
+ return if $path[0] eq ""; # not root directory
+ push(@path, ""); # volume only, effectively append ":"
+ }
+ @ps = @path;
+ @path = ();
+ my $part;
+ for (@ps) { #fix up "." and "..", including interior, in relatives
+ next if $_ eq ".";
+ $part = $_ eq ".." ? "" : $_;
+ push(@path,$part);
+ }
+ if ($ps[-1] eq "..") { #if this happens, we need another :
+ push(@path,"");
+ }
+
+ } else {
+ $pre = ":";
+ @ps = @path;
+ @path = ();
+ my $part;
+ for (@ps) { #fix up "." and "..", including interior, in relatives
+ next if $_ eq ".";
+ $part = $_ eq ".." ? "" : $_;
+ push(@path,$part);
+ }
+ if ($ps[-1] eq "..") { #if this happens, we need another :
+ push(@path,"");
+ }
+
+ }
+ return unless $pre || @path;
+ for (@path) {
+ s/;.*//; # get rid of parameters
+ #return unless length; # XXX
+ $_ = uri_unescape($_);
+ return if /\0/;
+ return if /:/; # Should we?
+ }
+ $pre . join(":", @path);
+}
+
+sub dir
+{
+ my $class = shift;
+ my $path = $class->file(@_);
+ return unless defined $path;
+ $path .= ":" unless $path =~ /:$/;
+ $path;
+}
+
+1;
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
new file mode 100644
index 0000000000..a3cbf980b3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/OS2.pm
@@ -0,0 +1,32 @@
+package URI::file::OS2;
+
+use strict;
+use warnings;
+
+use parent 'URI::file::Win32';
+
+our $VERSION = '1.76';
+
+# The Win32 version translates k:/foo to file://k:/foo (?!)
+# We add an empty host
+
+sub _file_extract_authority
+{
+ my $class = shift;
+ return $1 if $_[0] =~ s,^\\\\([^\\]+),,; # UNC
+ return $1 if $_[0] =~ s,^//([^/]+),,; # UNC too?
+
+ if ($_[0] =~ m#^[a-zA-Z]{1,2}:#) { # allow for ab: drives
+ return "";
+ }
+ return;
+}
+
+sub file {
+ my $p = &URI::file::Win32::file;
+ return unless defined $p;
+ $p =~ s,\\,/,g;
+ $p;
+}
+
+1;
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
new file mode 100644
index 0000000000..995fd632e2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/QNX.pm
@@ -0,0 +1,20 @@
+package URI::file::QNX;
+
+use strict;
+use warnings;
+
+use parent 'URI::file::Unix';
+
+our $VERSION = '1.76';
+
+sub _file_extract_path
+{
+ my($class, $path) = @_;
+ # tidy path
+ $path =~ s,(.)//+,$1/,g; # ^// is correct
+ $path =~ s,(/\.)+/,/,g;
+ $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:"
+ $path;
+}
+
+1;
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
new file mode 100644
index 0000000000..869e8991a7
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Unix.pm
@@ -0,0 +1,58 @@
+package URI::file::Unix;
+
+use strict;
+use warnings;
+
+use parent 'URI::file::Base';
+
+use URI::Escape qw(uri_unescape);
+
+our $VERSION = '1.76';
+
+sub _file_extract_path
+{
+ my($class, $path) = @_;
+
+ # tidy path
+ $path =~ s,//+,/,g;
+ $path =~ s,(/\.)+/,/,g;
+ $path = "./$path" if $path =~ m,^[^:/]+:,,; # look like "scheme:"
+
+ return $path;
+}
+
+sub _file_is_absolute {
+ my($class, $path) = @_;
+ return $path =~ m,^/,;
+}
+
+sub file
+{
+ my $class = shift;
+ my $uri = shift;
+ my @path;
+
+ my $auth = $uri->authority;
+ if (defined($auth)) {
+ if (lc($auth) ne "localhost" && $auth ne "") {
+ $auth = uri_unescape($auth);
+ unless ($class->_file_is_localhost($auth)) {
+ push(@path, "", "", $auth);
+ }
+ }
+ }
+
+ my @ps = $uri->path_segments;
+ shift @ps if @path;
+ push(@path, @ps);
+
+ for (@path) {
+ # Unix file/directory names are not allowed to contain '\0' or '/'
+ return undef if /\0/;
+ return undef if /\//; # should we really?
+ }
+
+ return join("/", @path);
+}
+
+1;
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
new file mode 100644
index 0000000000..d4f1ecfe56
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/file/Win32.pm
@@ -0,0 +1,87 @@
+package URI::file::Win32;
+
+use strict;
+use warnings;
+
+use parent 'URI::file::Base';
+
+use URI::Escape qw(uri_unescape);
+
+our $VERSION = '1.76';
+
+sub _file_extract_authority
+{
+ my $class = shift;
+
+ return $class->SUPER::_file_extract_authority($_[0])
+ if defined $URI::file::DEFAULT_AUTHORITY;
+
+ return $1 if $_[0] =~ s,^\\\\([^\\]+),,; # UNC
+ return $1 if $_[0] =~ s,^//([^/]+),,; # UNC too?
+
+ if ($_[0] =~ s,^([a-zA-Z]:),,) {
+ my $auth = $1;
+ $auth .= "relative" if $_[0] !~ m,^[\\/],;
+ return $auth;
+ }
+ return undef;
+}
+
+sub _file_extract_path
+{
+ my($class, $path) = @_;
+ $path =~ s,\\,/,g;
+ #$path =~ s,//+,/,g;
+ $path =~ s,(/\.)+/,/,g;
+
+ if (defined $URI::file::DEFAULT_AUTHORITY) {
+ $path =~ s,^([a-zA-Z]:),/$1,;
+ }
+
+ return $path;
+}
+
+sub _file_is_absolute {
+ my($class, $path) = @_;
+ return $path =~ m,^[a-zA-Z]:, || $path =~ m,^[/\\],;
+}
+
+sub file
+{
+ my $class = shift;
+ my $uri = shift;
+ my $auth = $uri->authority;
+ my $rel; # is filename relative to drive specified in authority
+ if (defined $auth) {
+ $auth = uri_unescape($auth);
+ if ($auth =~ /^([a-zA-Z])[:|](relative)?/) {
+ $auth = uc($1) . ":";
+ $rel++ if $2;
+ } elsif (lc($auth) eq "localhost") {
+ $auth = "";
+ } elsif (length $auth) {
+ $auth = "\\\\" . $auth; # UNC
+ }
+ } else {
+ $auth = "";
+ }
+
+ my @path = $uri->path_segments;
+ for (@path) {
+ return undef if /\0/;
+ return undef if /\//;
+ #return undef if /\\/; # URLs with "\" is not uncommon
+ }
+ return undef unless $class->fix_path(@path);
+
+ my $path = join("\\", @path);
+ $path =~ s/^\\// if $rel;
+ $path = $auth . $path;
+ $path =~ s,^\\([a-zA-Z])[:|],\u$1:,;
+
+ return $path;
+}
+
+sub fix_path { 1; }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm
new file mode 100644
index 0000000000..e2d195026d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ftp.pm
@@ -0,0 +1,46 @@
+package URI::ftp;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent qw(URI::_server URI::_userpass);
+
+sub default_port { 21 }
+
+sub path { shift->path_query(@_) } # XXX
+
+sub _user { shift->SUPER::user(@_); }
+sub _password { shift->SUPER::password(@_); }
+
+sub user
+{
+ my $self = shift;
+ my $user = $self->_user(@_);
+ $user = "anonymous" unless defined $user;
+ $user;
+}
+
+sub password
+{
+ my $self = shift;
+ my $pass = $self->_password(@_);
+ unless (defined $pass) {
+ my $user = $self->user;
+ if ($user eq 'anonymous' || $user eq 'ftp') {
+ # anonymous ftp login password
+ # If there is no ftp anonymous password specified
+ # then we'll just use 'anonymous@'
+ # We don't try to send the read e-mail address because:
+ # - We want to remain anonymous
+ # - We want to stop SPAM
+ # - We don't want to let ftp sites to discriminate by the user,
+ # host, country or ftp client being used.
+ $pass = 'anonymous@';
+ }
+ }
+ $pass;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm
new file mode 100644
index 0000000000..00bc363a9e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/gopher.pm
@@ -0,0 +1,97 @@
+package URI::gopher; # <draft-murali-url-gopher>, Dec 4, 1996
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::_server';
+
+use URI::Escape qw(uri_unescape);
+
+# A Gopher URL follows the common internet scheme syntax as defined in
+# section 4.3 of [RFC-URL-SYNTAX]:
+#
+# gopher://<host>[:<port>]/<gopher-path>
+#
+# where
+#
+# <gopher-path> := <gopher-type><selector> |
+# <gopher-type><selector>%09<search> |
+# <gopher-type><selector>%09<search>%09<gopher+_string>
+#
+# <gopher-type> := '0' | '1' | '2' | '3' | '4' | '5' | '6' | '7'
+# '8' | '9' | '+' | 'I' | 'g' | 'T'
+#
+# <selector> := *pchar Refer to RFC 1808 [4]
+# <search> := *pchar
+# <gopher+_string> := *uchar Refer to RFC 1738 [3]
+#
+# If the optional port is omitted, the port defaults to 70.
+
+sub default_port { 70 }
+
+sub _gopher_type
+{
+ my $self = shift;
+ my $path = $self->path_query;
+ $path =~ s,^/,,;
+ my $gtype = $1 if $path =~ s/^(.)//s;
+ if (@_) {
+ my $new_type = shift;
+ if (defined($new_type)) {
+ Carp::croak("Bad gopher type '$new_type'")
+ unless length($new_type) == 1;
+ substr($path, 0, 0) = $new_type;
+ $self->path_query($path);
+ } else {
+ Carp::croak("Can't delete gopher type when selector is present")
+ if length($path);
+ $self->path_query(undef);
+ }
+ }
+ return $gtype;
+}
+
+sub gopher_type
+{
+ my $self = shift;
+ my $gtype = $self->_gopher_type(@_);
+ $gtype = "1" unless defined $gtype;
+ $gtype;
+}
+
+sub gtype { goto &gopher_type } # URI::URL compatibility
+
+sub selector { shift->_gfield(0, @_) }
+sub search { shift->_gfield(1, @_) }
+sub string { shift->_gfield(2, @_) }
+
+sub _gfield
+{
+ my $self = shift;
+ my $fno = shift;
+ my $path = $self->path_query;
+
+ # not according to spec., but many popular browsers accept
+ # gopher URLs with a '?' before the search string.
+ $path =~ s/\?/\t/;
+ $path = uri_unescape($path);
+ $path =~ s,^/,,;
+ my $gtype = $1 if $path =~ s,^(.),,s;
+ my @path = split(/\t/, $path, 3);
+ if (@_) {
+ # modify
+ my $new = shift;
+ $path[$fno] = $new;
+ pop(@path) while @path && !defined($path[-1]);
+ for (@path) { $_="" unless defined }
+ $path = $gtype;
+ $path = "1" unless defined $path;
+ $path .= join("\t", @path);
+ $self->path_query($path);
+ }
+ $path[$fno];
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm
new file mode 100644
index 0000000000..1b02cac9aa
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/http.pm
@@ -0,0 +1,27 @@
+package URI::http;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::_server';
+
+sub default_port { 80 }
+
+sub canonical
+{
+ my $self = shift;
+ my $other = $self->SUPER::canonical;
+
+ my $slash_path = defined($other->authority) &&
+ !length($other->path) && !defined($other->query);
+
+ if ($slash_path) {
+ $other = $other->clone if $other == $self;
+ $other->path("/");
+ }
+ $other;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm
new file mode 100644
index 0000000000..f40636bb94
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/https.pm
@@ -0,0 +1,14 @@
+package URI::https;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::http';
+
+sub default_port { 443 }
+
+sub secure { 1 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm
new file mode 100644
index 0000000000..813bff9ea2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldap.pm
@@ -0,0 +1,120 @@
+# Copyright (c) 1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
+# modify it under the same terms as Perl itself.
+
+package URI::ldap;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent qw(URI::_ldap URI::_server);
+
+sub default_port { 389 }
+
+sub _nonldap_canonical {
+ my $self = shift;
+ $self->URI::_server::canonical(@_);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+URI::ldap - LDAP Uniform Resource Locators
+
+=head1 SYNOPSIS
+
+ use URI;
+
+ $uri = URI->new("ldap:$uri_string");
+ $dn = $uri->dn;
+ $filter = $uri->filter;
+ @attr = $uri->attributes;
+ $scope = $uri->scope;
+ %extn = $uri->extensions;
+
+ $uri = URI->new("ldap:"); # start empty
+ $uri->host("ldap.itd.umich.edu");
+ $uri->dn("o=University of Michigan,c=US");
+ $uri->attributes(qw(postalAddress));
+ $uri->scope('sub');
+ $uri->filter('(cn=Babs Jensen)');
+ print $uri->as_string,"\n";
+
+=head1 DESCRIPTION
+
+C<URI::ldap> provides an interface to parse an LDAP URI into its
+constituent parts and also to build a URI as described in
+RFC 2255.
+
+=head1 METHODS
+
+C<URI::ldap> supports all the generic and server methods defined by
+L<URI>, plus the following.
+
+Each of the following methods can be used to set or get the value in
+the URI. The values are passed in unescaped form. None of these
+return undefined values, but elements without a default can be empty.
+If arguments are given, then a new value is set for the given part
+of the URI.
+
+=over 4
+
+=item $uri->dn( [$new_dn] )
+
+Sets or gets the I<Distinguished Name> part of the URI. The DN
+identifies the base object of the LDAP search.
+
+=item $uri->attributes( [@new_attrs] )
+
+Sets or gets the list of attribute names which are
+returned by the search.
+
+=item $uri->scope( [$new_scope] )
+
+Sets or gets the scope to be used by the search. The value can be one of
+C<"base">, C<"one"> or C<"sub">. If none is given in the URI then the
+return value defaults to C<"base">.
+
+=item $uri->_scope( [$new_scope] )
+
+Same as scope(), but does not default to anything.
+
+=item $uri->filter( [$new_filter] )
+
+Sets or gets the filter to be used by the search. If none is given in
+the URI then the return value defaults to C<"(objectClass=*)">.
+
+=item $uri->_filter( [$new_filter] )
+
+Same as filter(), but does not default to anything.
+
+=item $uri->extensions( [$etype => $evalue,...] )
+
+Sets or gets the extensions used for the search. The list passed should
+be in the form etype1 => evalue1, etype2 => evalue2,... This is also
+the form of list that is returned.
+
+=back
+
+=head1 SEE ALSO
+
+L<http://tools.ietf.org/html/rfc2255>
+
+=head1 AUTHOR
+
+Graham Barr E<lt>F<gbarr@pobox.com>E<gt>
+
+Slightly modified by Gisle Aas to fit into the URI distribution.
+
+=head1 COPYRIGHT
+
+Copyright (c) 1998 Graham Barr. All rights reserved. This program 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/URI/ldapi.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm
new file mode 100644
index 0000000000..b138c8849c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldapi.pm
@@ -0,0 +1,29 @@
+package URI::ldapi;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent qw(URI::_ldap URI::_generic);
+
+require URI::Escape;
+
+sub un_path {
+ my $self = shift;
+ my $old = URI::Escape::uri_unescape($self->authority);
+ if (@_) {
+ my $p = shift;
+ $p =~ s/:/%3A/g;
+ $p =~ s/\@/%40/g;
+ $self->authority($p);
+ }
+ return $old;
+}
+
+sub _nonldap_canonical {
+ my $self = shift;
+ $self->URI::_generic::canonical(@_);
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm
new file mode 100644
index 0000000000..02ad5115fb
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ldaps.pm
@@ -0,0 +1,14 @@
+package URI::ldaps;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::ldap';
+
+sub default_port { 636 }
+
+sub secure { 1 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm
new file mode 100644
index 0000000000..300386ef44
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mailto.pm
@@ -0,0 +1,73 @@
+package URI::mailto; # RFC 2368
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent qw(URI URI::_query);
+
+sub to
+{
+ my $self = shift;
+ my @old = $self->headers;
+ if (@_) {
+ my @new = @old;
+ # get rid of any other to: fields
+ for (my $i = 0; $i < @new; $i += 2) {
+ if (lc($new[$i] || '') eq "to") {
+ splice(@new, $i, 2);
+ redo;
+ }
+ }
+
+ my $to = shift;
+ $to = "" unless defined $to;
+ unshift(@new, "to" => $to);
+ $self->headers(@new);
+ }
+ return unless defined wantarray;
+
+ my @to;
+ while (@old) {
+ my $h = shift @old;
+ my $v = shift @old;
+ push(@to, $v) if lc($h) eq "to";
+ }
+ join(",", @to);
+}
+
+
+sub headers
+{
+ my $self = shift;
+
+ # The trick is to just treat everything as the query string...
+ my $opaque = "to=" . $self->opaque;
+ $opaque =~ s/\?/&/;
+
+ if (@_) {
+ my @new = @_;
+
+ # strip out any "to" fields
+ my @to;
+ for (my $i=0; $i < @new; $i += 2) {
+ if (lc($new[$i] || '') eq "to") {
+ push(@to, (splice(@new, $i, 2))[1]); # remove header
+ redo;
+ }
+ }
+
+ my $new = join(",",@to);
+ $new =~ s/%/%25/g;
+ $new =~ s/\?/%3F/g;
+ $self->opaque($new);
+ $self->query_form(@new) if @new;
+ }
+ return unless defined wantarray;
+
+ # I am lazy today...
+ URI->new("mailto:?$opaque")->query_form;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm
new file mode 100644
index 0000000000..3c0e44f054
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/mms.pm
@@ -0,0 +1,12 @@
+package URI::mms;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::http';
+
+sub default_port { 1755 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm
new file mode 100644
index 0000000000..55dcf71556
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/news.pm
@@ -0,0 +1,71 @@
+package URI::news; # draft-gilman-news-url-01
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::_server';
+
+use URI::Escape qw(uri_unescape);
+use Carp ();
+
+sub default_port { 119 }
+
+# newsURL = scheme ":" [ news-server ] [ refbygroup | message ]
+# scheme = "news" | "snews" | "nntp"
+# news-server = "//" server "/"
+# refbygroup = group [ "/" messageno [ "-" messageno ] ]
+# message = local-part "@" domain
+
+sub _group
+{
+ my $self = shift;
+ my $old = $self->path;
+ if (@_) {
+ my($group,$from,$to) = @_;
+ if ($group =~ /\@/) {
+ $group =~ s/^<(.*)>$/$1/; # "<" and ">" should not be part of it
+ }
+ $group =~ s,%,%25,g;
+ $group =~ s,/,%2F,g;
+ my $path = $group;
+ if (defined $from) {
+ $path .= "/$from";
+ $path .= "-$to" if defined $to;
+ }
+ $self->path($path);
+ }
+
+ $old =~ s,^/,,;
+ if ($old !~ /\@/ && $old =~ s,/(.*),, && wantarray) {
+ my $extra = $1;
+ return (uri_unescape($old), split(/-/, $extra));
+ }
+ uri_unescape($old);
+}
+
+
+sub group
+{
+ my $self = shift;
+ if (@_) {
+ Carp::croak("Group name can't contain '\@'") if $_[0] =~ /\@/;
+ }
+ my @old = $self->_group(@_);
+ return if $old[0] =~ /\@/;
+ wantarray ? @old : $old[0];
+}
+
+sub message
+{
+ my $self = shift;
+ if (@_) {
+ Carp::croak("Message must contain '\@'") unless $_[0] =~ /\@/;
+ }
+ my $old = $self->_group(@_);
+ return undef unless $old =~ /\@/;
+ return $old;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm
new file mode 100644
index 0000000000..80bd9429f9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/nntp.pm
@@ -0,0 +1,10 @@
+package URI::nntp; # draft-gilman-news-url-01
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::news';
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm
new file mode 100644
index 0000000000..ba824c01b0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/pop.pm
@@ -0,0 +1,71 @@
+package URI::pop; # RFC 2384
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::_server';
+
+use URI::Escape qw(uri_unescape);
+
+sub default_port { 110 }
+
+#pop://<user>;auth=<auth>@<host>:<port>
+
+sub user
+{
+ my $self = shift;
+ my $old = $self->userinfo;
+
+ if (@_) {
+ my $new_info = $old;
+ $new_info = "" unless defined $new_info;
+ $new_info =~ s/^[^;]*//;
+
+ my $new = shift;
+ if (!defined($new) && !length($new_info)) {
+ $self->userinfo(undef);
+ } else {
+ $new = "" unless defined $new;
+ $new =~ s/%/%25/g;
+ $new =~ s/;/%3B/g;
+ $self->userinfo("$new$new_info");
+ }
+ }
+
+ return undef unless defined $old;
+ $old =~ s/;.*//;
+ return uri_unescape($old);
+}
+
+sub auth
+{
+ my $self = shift;
+ my $old = $self->userinfo;
+
+ if (@_) {
+ my $new = $old;
+ $new = "" unless defined $new;
+ $new =~ s/(^[^;]*)//;
+ my $user = $1;
+ $new =~ s/;auth=[^;]*//i;
+
+
+ my $auth = shift;
+ if (defined $auth) {
+ $auth =~ s/%/%25/g;
+ $auth =~ s/;/%3B/g;
+ $new = ";AUTH=$auth$new";
+ }
+ $self->userinfo("$user$new");
+
+ }
+
+ return undef unless defined $old;
+ $old =~ s/^[^;]*//;
+ return uri_unescape($1) if $old =~ /;auth=(.*)/i;
+ return;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm
new file mode 100644
index 0000000000..9dd5667486
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rlogin.pm
@@ -0,0 +1,12 @@
+package URI::rlogin;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::_login';
+
+sub default_port { 513 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm
new file mode 100644
index 0000000000..fb6fc132f4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rsync.pm
@@ -0,0 +1,14 @@
+package URI::rsync; # http://rsync.samba.org/
+
+# rsync://[USER@]HOST[:PORT]/SRC
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent qw(URI::_server URI::_userpass);
+
+sub default_port { 873 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm
new file mode 100644
index 0000000000..b06193ad3b
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtsp.pm
@@ -0,0 +1,12 @@
+package URI::rtsp;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::http';
+
+sub default_port { 554 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm
new file mode 100644
index 0000000000..8ed9707da4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/rtspu.pm
@@ -0,0 +1,12 @@
+package URI::rtspu;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::rtsp';
+
+sub default_port { 554 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm
new file mode 100644
index 0000000000..93ff152ed1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sftp.pm
@@ -0,0 +1,10 @@
+package URI::sftp;
+
+use strict;
+use warnings;
+
+use parent 'URI::ssh';
+
+our $VERSION = '1.76';
+
+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
new file mode 100644
index 0000000000..d793a3f57a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sip.pm
@@ -0,0 +1,85 @@
+#
+# Written by Ryan Kereliuk <ryker@ryker.org>. This file may be
+# distributed under the same terms as Perl itself.
+#
+# The RFC 3261 sip URI is <scheme>:<authority>;<params>?<query>.
+#
+
+package URI::sip;
+
+use strict;
+use warnings;
+
+use parent qw(URI::_server URI::_userpass);
+
+use URI::Escape qw(uri_unescape);
+
+our $VERSION = '1.76';
+
+sub default_port { 5060 }
+
+sub authority
+{
+ my $self = shift;
+ $$self =~ m,^($URI::scheme_re:)?([^;?]*)(.*)$,os or die;
+ my $old = $2;
+
+ 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;
+ }
+ $old;
+}
+
+sub params_form
+{
+ my $self = shift;
+ $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
+ my $paramstr = $3;
+
+ 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]");
+ }
+ $paramstr = join(";", @new);
+ $$self .= ";" . $paramstr . $rest;
+ }
+ $paramstr =~ s/^;//o;
+ return split(/[;=]/, $paramstr);
+}
+
+sub params
+{
+ my $self = shift;
+ $$self =~ m,^((?:$URI::scheme_re:)?)(?:([^;?]*))?(;[^?]*)?(.*)$,os or die;
+ my $paramstr = $3;
+
+ if (@_) {
+ my $new = shift;
+ $$self = $1 . $2;
+ my $rest = $4;
+ $$self .= $paramstr . $rest;
+ }
+ $paramstr =~ s/^;//o;
+ return $paramstr;
+}
+
+# Inherited methods that make no sense for a SIP URI.
+sub path {}
+sub path_query {}
+sub path_segments {}
+sub abs { shift }
+sub rel { shift }
+sub query_keywords {}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm
new file mode 100644
index 0000000000..4d5553b531
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/sips.pm
@@ -0,0 +1,14 @@
+package URI::sips;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::sip';
+
+sub default_port { 5061 }
+
+sub secure { 1 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm
new file mode 100644
index 0000000000..9911046396
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/snews.pm
@@ -0,0 +1,14 @@
+package URI::snews; # draft-gilman-news-url-01
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::news';
+
+sub default_port { 563 }
+
+sub secure { 1 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm
new file mode 100644
index 0000000000..c4848f02f8
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/ssh.pm
@@ -0,0 +1,16 @@
+package URI::ssh;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::_login';
+
+# ssh://[USER@]HOST[:PORT]/SRC
+
+sub default_port { 22 }
+
+sub secure { 1 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm
new file mode 100644
index 0000000000..4d95a6200c
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/telnet.pm
@@ -0,0 +1,12 @@
+package URI::telnet;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::_login';
+
+sub default_port { 23 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm
new file mode 100644
index 0000000000..cdcabbde85
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/tn3270.pm
@@ -0,0 +1,12 @@
+package URI::tn3270;
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::_login';
+
+sub default_port { 23 }
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm
new file mode 100644
index 0000000000..bca02cb788
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn.pm
@@ -0,0 +1,105 @@
+package URI::urn; # RFC 2141
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI';
+
+use Carp qw(carp);
+
+my %implementor;
+my %require_attempted;
+
+sub _init {
+ my $class = shift;
+ my $self = $class->SUPER::_init(@_);
+ my $nid = $self->nid;
+
+ my $impclass = $implementor{$nid};
+ return $impclass->_urn_init($self, $nid) if $impclass;
+
+ $impclass = "URI::urn";
+ if ($nid =~ /^[A-Za-z\d][A-Za-z\d\-]*\z/) {
+ my $id = $nid;
+ # make it a legal perl identifier
+ $id =~ s/-/_/g;
+ $id = "_$id" if $id =~ /^\d/;
+
+ $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"};
+ }
+ }
+ else {
+ carp("Illegal namespace identifier '$nid' for URN '$self'") if $^W;
+ }
+ $implementor{$nid} = $impclass;
+
+ return $impclass->_urn_init($self, $nid);
+}
+
+sub _urn_init {
+ my($class, $self, $nid) = @_;
+ bless $self, $class;
+}
+
+sub _nid {
+ my $self = shift;
+ my $opaque = $self->opaque;
+ if (@_) {
+ my $v = $opaque;
+ my $new = shift;
+ $v =~ s/[^:]*/$new/;
+ $self->opaque($v);
+ # XXX possible rebless
+ }
+ $opaque =~ s/:.*//s;
+ return $opaque;
+}
+
+sub nid { # namespace identifier
+ my $self = shift;
+ my $nid = $self->_nid(@_);
+ $nid = lc($nid) if defined($nid);
+ return $nid;
+}
+
+sub nss { # namespace specific string
+ my $self = shift;
+ my $opaque = $self->opaque;
+ if (@_) {
+ my $v = $opaque;
+ my $new = shift;
+ if (defined $new) {
+ $v =~ s/(:|\z).*/:$new/;
+ }
+ else {
+ $v =~ s/:.*//s;
+ }
+ $self->opaque($v);
+ }
+ return undef unless $opaque =~ s/^[^:]*://;
+ return $opaque;
+}
+
+sub canonical {
+ my $self = shift;
+ my $nid = $self->_nid;
+ my $new = $self->SUPER::canonical;
+ return $new if $nid !~ /[A-Z]/ || $nid =~ /%/;
+ $new = $new->clone if $new == $self;
+ $new->nid(lc($nid));
+ return $new;
+}
+
+1;
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
new file mode 100644
index 0000000000..9246345944
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/isbn.pm
@@ -0,0 +1,105 @@
+package URI::urn::isbn; # RFC 3187
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::urn';
+
+use Carp qw(carp);
+
+BEGIN {
+ require Business::ISBN;
+
+ local $^W = 0; # don't warn about dev versions, perl5.004 style
+ warn "Using Business::ISBN version " . Business::ISBN->VERSION .
+ " which is deprecated.\nUpgrade to Business::ISBN version 2\n"
+ if Business::ISBN->VERSION < 2;
+ }
+
+sub _isbn {
+ my $nss = shift;
+ $nss = $nss->nss if ref($nss);
+ my $isbn = Business::ISBN->new($nss);
+ $isbn = undef if $isbn && !$isbn->is_valid;
+ return $isbn;
+}
+
+sub _nss_isbn {
+ my $self = shift;
+ my $nss = $self->nss(@_);
+ my $isbn = _isbn($nss);
+ $isbn = $isbn->as_string if $isbn;
+ return($nss, $isbn);
+}
+
+sub isbn {
+ my $self = shift;
+ my $isbn;
+ (undef, $isbn) = $self->_nss_isbn(@_);
+ return $isbn;
+}
+
+sub isbn_publisher_code {
+ my $isbn = shift->_isbn || return undef;
+ return $isbn->publisher_code;
+}
+
+BEGIN {
+my $group_method = do {
+ local $^W = 0; # don't warn about dev versions, perl5.004 style
+ Business::ISBN->VERSION >= 2 ? 'group_code' : 'country_code';
+ };
+
+sub isbn_group_code {
+ my $isbn = shift->_isbn || return undef;
+ return $isbn->$group_method;
+}
+}
+
+sub isbn_country_code {
+ my $name = (caller(0))[3]; $name =~ s/.*:://;
+ carp "$name is DEPRECATED. Use isbn_group_code instead";
+
+ no strict 'refs';
+ &isbn_group_code;
+}
+
+BEGIN {
+my $isbn13_method = do {
+ local $^W = 0; # don't warn about dev versions, perl5.004 style
+ Business::ISBN->VERSION >= 2 ? 'as_isbn13' : 'as_ean';
+ };
+
+sub isbn13 {
+ my $isbn = shift->_isbn || return undef;
+
+ # Business::ISBN 1.x didn't put hyphens in the EAN, and it was just a string
+ # Business::ISBN 2.0 doesn't do EAN, but it does ISBN-13 objects
+ # and it uses the hyphens, so call as_string with an empty anon array
+ # or, adjust the test and features to say that it comes out with hyphens.
+ my $thingy = $isbn->$isbn13_method;
+ return eval { $thingy->can( 'as_string' ) } ? $thingy->as_string([]) : $thingy;
+}
+}
+
+sub isbn_as_ean {
+ my $name = (caller(0))[3]; $name =~ s/.*:://;
+ carp "$name is DEPRECATED. Use isbn13 instead";
+
+ no strict 'refs';
+ &isbn13;
+}
+
+sub canonical {
+ my $self = shift;
+ my($nss, $isbn) = $self->_nss_isbn;
+ my $new = $self->SUPER::canonical;
+ return $new unless $nss && $isbn && $nss ne $isbn;
+ $new = $new->clone if $new == $self;
+ $new->nss($isbn);
+ return $new;
+}
+
+1;
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
new file mode 100644
index 0000000000..2a4a0f9dcd
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/URI/urn/oid.pm
@@ -0,0 +1,20 @@
+package URI::urn::oid; # RFC 2061
+
+use strict;
+use warnings;
+
+our $VERSION = '1.76';
+
+use parent 'URI::urn';
+
+sub oid {
+ my $self = shift;
+ my $old = $self->nss;
+ if (@_) {
+ $self->nss(join(".", @_));
+ }
+ return split(/\./, $old) if wantarray;
+ return $old;
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/WWW/RobotRules.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/WWW/RobotRules.pm
new file mode 100644
index 0000000000..5dfc453934
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/WWW/RobotRules.pm
@@ -0,0 +1,453 @@
+package WWW::RobotRules;
+
+$VERSION = "6.02";
+sub Version { $VERSION; }
+
+use strict;
+use URI ();
+
+
+
+sub new {
+ my($class, $ua) = @_;
+
+ # This ugly hack is needed to ensure backwards compatibility.
+ # The "WWW::RobotRules" class is now really abstract.
+ $class = "WWW::RobotRules::InCore" if $class eq "WWW::RobotRules";
+
+ my $self = bless { }, $class;
+ $self->agent($ua);
+ $self;
+}
+
+
+sub parse {
+ my($self, $robot_txt_uri, $txt, $fresh_until) = @_;
+ $robot_txt_uri = URI->new("$robot_txt_uri");
+ my $netloc = $robot_txt_uri->host . ":" . $robot_txt_uri->port;
+
+ $self->clear_rules($netloc);
+ $self->fresh_until($netloc, $fresh_until || (time + 365*24*3600));
+
+ my $ua;
+ my $is_me = 0; # 1 iff this record is for me
+ my $is_anon = 0; # 1 iff this record is for *
+ my $seen_disallow = 0; # watch for missing record separators
+ my @me_disallowed = (); # rules disallowed for me
+ my @anon_disallowed = (); # rules disallowed for *
+
+ # blank lines are significant, so turn CRLF into LF to avoid generating
+ # false ones
+ $txt =~ s/\015\012/\012/g;
+
+ # split at \012 (LF) or \015 (CR) (Mac text files have just CR for EOL)
+ for(split(/[\012\015]/, $txt)) {
+
+ # Lines containing only a comment are discarded completely, and
+ # therefore do not indicate a record boundary.
+ next if /^\s*\#/;
+
+ s/\s*\#.*//; # remove comments at end-of-line
+
+ if (/^\s*$/) { # blank line
+ last if $is_me; # That was our record. No need to read the rest.
+ $is_anon = 0;
+ $seen_disallow = 0;
+ }
+ elsif (/^\s*User-Agent\s*:\s*(.*)/i) {
+ $ua = $1;
+ $ua =~ s/\s+$//;
+
+ if ($seen_disallow) {
+ # treat as start of a new record
+ $seen_disallow = 0;
+ last if $is_me; # That was our record. No need to read the rest.
+ $is_anon = 0;
+ }
+
+ if ($is_me) {
+ # This record already had a User-agent that
+ # we matched, so just continue.
+ }
+ elsif ($ua eq '*') {
+ $is_anon = 1;
+ }
+ elsif($self->is_me($ua)) {
+ $is_me = 1;
+ }
+ }
+ elsif (/^\s*Disallow\s*:\s*(.*)/i) {
+ unless (defined $ua) {
+ warn "RobotRules <$robot_txt_uri>: Disallow without preceding User-agent\n" if $^W;
+ $is_anon = 1; # assume that User-agent: * was intended
+ }
+ my $disallow = $1;
+ $disallow =~ s/\s+$//;
+ $seen_disallow = 1;
+ if (length $disallow) {
+ my $ignore;
+ eval {
+ my $u = URI->new_abs($disallow, $robot_txt_uri);
+ $ignore++ if $u->scheme ne $robot_txt_uri->scheme;
+ $ignore++ if lc($u->host) ne lc($robot_txt_uri->host);
+ $ignore++ if $u->port ne $robot_txt_uri->port;
+ $disallow = $u->path_query;
+ $disallow = "/" unless length $disallow;
+ };
+ next if $@;
+ next if $ignore;
+ }
+
+ if ($is_me) {
+ push(@me_disallowed, $disallow);
+ }
+ elsif ($is_anon) {
+ push(@anon_disallowed, $disallow);
+ }
+ }
+ elsif (/\S\s*:/) {
+ # ignore
+ }
+ else {
+ warn "RobotRules <$robot_txt_uri>: Malformed record: <$_>\n" if $^W;
+ }
+ }
+
+ if ($is_me) {
+ $self->push_rules($netloc, @me_disallowed);
+ }
+ else {
+ $self->push_rules($netloc, @anon_disallowed);
+ }
+}
+
+
+#
+# Returns TRUE if the given name matches the
+# name of this robot
+#
+sub is_me {
+ my($self, $ua_line) = @_;
+ my $me = $self->agent;
+
+ # See whether my short-name is a substring of the
+ # "User-Agent: ..." line that we were passed:
+
+ if(index(lc($me), lc($ua_line)) >= 0) {
+ return 1;
+ }
+ else {
+ return '';
+ }
+}
+
+
+sub allowed {
+ my($self, $uri) = @_;
+ $uri = URI->new("$uri");
+
+ return 1 unless $uri->scheme eq 'http' or $uri->scheme eq 'https';
+ # Robots.txt applies to only those schemes.
+
+ my $netloc = $uri->host . ":" . $uri->port;
+
+ my $fresh_until = $self->fresh_until($netloc);
+ return -1 if !defined($fresh_until) || $fresh_until < time;
+
+ my $str = $uri->path_query;
+ my $rule;
+ for $rule ($self->rules($netloc)) {
+ return 1 unless length $rule;
+ return 0 if index($str, $rule) == 0;
+ }
+ return 1;
+}
+
+
+# The following methods must be provided by the subclass.
+sub agent;
+sub visit;
+sub no_visits;
+sub last_visits;
+sub fresh_until;
+sub push_rules;
+sub clear_rules;
+sub rules;
+sub dump;
+
+
+
+package WWW::RobotRules::InCore;
+
+use vars qw(@ISA);
+@ISA = qw(WWW::RobotRules);
+
+
+
+sub agent {
+ my ($self, $name) = @_;
+ my $old = $self->{'ua'};
+ if ($name) {
+ # Strip it so that it's just the short name.
+ # I.e., "FooBot" => "FooBot"
+ # "FooBot/1.2" => "FooBot"
+ # "FooBot/1.2 [http://foobot.int; foo@bot.int]" => "FooBot"
+
+ $name = $1 if $name =~ m/(\S+)/; # get first word
+ $name =~ s!/.*!!; # get rid of version
+ unless ($old && $old eq $name) {
+ delete $self->{'loc'}; # all old info is now stale
+ $self->{'ua'} = $name;
+ }
+ }
+ $old;
+}
+
+
+sub visit {
+ my($self, $netloc, $time) = @_;
+ return unless $netloc;
+ $time ||= time;
+ $self->{'loc'}{$netloc}{'last'} = $time;
+ my $count = \$self->{'loc'}{$netloc}{'count'};
+ if (!defined $$count) {
+ $$count = 1;
+ }
+ else {
+ $$count++;
+ }
+}
+
+
+sub no_visits {
+ my ($self, $netloc) = @_;
+ $self->{'loc'}{$netloc}{'count'};
+}
+
+
+sub last_visit {
+ my ($self, $netloc) = @_;
+ $self->{'loc'}{$netloc}{'last'};
+}
+
+
+sub fresh_until {
+ my ($self, $netloc, $fresh_until) = @_;
+ my $old = $self->{'loc'}{$netloc}{'fresh'};
+ if (defined $fresh_until) {
+ $self->{'loc'}{$netloc}{'fresh'} = $fresh_until;
+ }
+ $old;
+}
+
+
+sub push_rules {
+ my($self, $netloc, @rules) = @_;
+ push (@{$self->{'loc'}{$netloc}{'rules'}}, @rules);
+}
+
+
+sub clear_rules {
+ my($self, $netloc) = @_;
+ delete $self->{'loc'}{$netloc}{'rules'};
+}
+
+
+sub rules {
+ my($self, $netloc) = @_;
+ if (defined $self->{'loc'}{$netloc}{'rules'}) {
+ return @{$self->{'loc'}{$netloc}{'rules'}};
+ }
+ else {
+ return ();
+ }
+}
+
+
+sub dump
+{
+ my $self = shift;
+ for (keys %$self) {
+ next if $_ eq 'loc';
+ print "$_ = $self->{$_}\n";
+ }
+ for (keys %{$self->{'loc'}}) {
+ my @rules = $self->rules($_);
+ print "$_: ", join("; ", @rules), "\n";
+ }
+}
+
+
+1;
+
+__END__
+
+
+# Bender: "Well, I don't have anything else
+# planned for today. Let's get drunk!"
+
+=head1 NAME
+
+WWW::RobotRules - database of robots.txt-derived permissions
+
+=head1 SYNOPSIS
+
+ use WWW::RobotRules;
+ my $rules = WWW::RobotRules->new('MOMspider/1.0');
+
+ use LWP::Simple qw(get);
+
+ {
+ my $url = "http://some.place/robots.txt";
+ my $robots_txt = get $url;
+ $rules->parse($url, $robots_txt) if defined $robots_txt;
+ }
+
+ {
+ my $url = "http://some.other.place/robots.txt";
+ my $robots_txt = get $url;
+ $rules->parse($url, $robots_txt) if defined $robots_txt;
+ }
+
+ # Now we can check if a URL is valid for those servers
+ # whose "robots.txt" files we've gotten and parsed:
+ if($rules->allowed($url)) {
+ $c = get $url;
+ ...
+ }
+
+=head1 DESCRIPTION
+
+This module parses F</robots.txt> files as specified in
+"A Standard for Robot Exclusion", at
+<http://www.robotstxt.org/wc/norobots.html>
+Webmasters can use the F</robots.txt> file to forbid conforming
+robots from accessing parts of their web site.
+
+The parsed files are kept in a WWW::RobotRules object, and this object
+provides methods to check if access to a given URL is prohibited. The
+same WWW::RobotRules object can be used for one or more parsed
+F</robots.txt> files on any number of hosts.
+
+The following methods are provided:
+
+=over 4
+
+=item $rules = WWW::RobotRules->new($robot_name)
+
+This is the constructor for WWW::RobotRules objects. The first
+argument given to new() is the name of the robot.
+
+=item $rules->parse($robot_txt_url, $content, $fresh_until)
+
+The parse() method takes as arguments the URL that was used to
+retrieve the F</robots.txt> file, and the contents of the file.
+
+=item $rules->allowed($uri)
+
+Returns TRUE if this robot is allowed to retrieve this URL.
+
+=item $rules->agent([$name])
+
+Get/set the agent name. NOTE: Changing the agent name will clear the robots.txt
+rules and expire times out of the cache.
+
+=back
+
+=head1 ROBOTS.TXT
+
+The format and semantics of the "/robots.txt" file are as follows
+(this is an edited abstract of
+<http://www.robotstxt.org/wc/norobots.html>):
+
+The file consists of one or more records separated by one or more
+blank lines. Each record contains lines of the form
+
+ <field-name>: <value>
+
+The field name is case insensitive. Text after the '#' character on a
+line is ignored during parsing. This is used for comments. The
+following <field-names> can be used:
+
+=over 3
+
+=item User-Agent
+
+The value of this field is the name of the robot the record is
+describing access policy for. If more than one I<User-Agent> field is
+present the record describes an identical access policy for more than
+one robot. At least one field needs to be present per record. If the
+value is '*', the record describes the default access policy for any
+robot that has not not matched any of the other records.
+
+The I<User-Agent> fields must occur before the I<Disallow> fields. If a
+record contains a I<User-Agent> field after a I<Disallow> field, that
+constitutes a malformed record. This parser will assume that a blank
+line should have been placed before that I<User-Agent> field, and will
+break the record into two. All the fields before the I<User-Agent> field
+will constitute a record, and the I<User-Agent> field will be the first
+field in a new record.
+
+=item Disallow
+
+The value of this field specifies a partial URL that is not to be
+visited. This can be a full path, or a partial path; any URL that
+starts with this value will not be retrieved
+
+=back
+
+Unrecognized records are ignored.
+
+=head1 ROBOTS.TXT EXAMPLES
+
+The following example "/robots.txt" file specifies that no robots
+should visit any URL starting with "/cyberworld/map/" or "/tmp/":
+
+ User-agent: *
+ Disallow: /cyberworld/map/ # This is an infinite virtual URL space
+ Disallow: /tmp/ # these will soon disappear
+
+This example "/robots.txt" file specifies that no robots should visit
+any URL starting with "/cyberworld/map/", except the robot called
+"cybermapper":
+
+ User-agent: *
+ Disallow: /cyberworld/map/ # This is an infinite virtual URL space
+
+ # Cybermapper knows where to go.
+ User-agent: cybermapper
+ Disallow:
+
+This example indicates that no robots should visit this site further:
+
+ # go away
+ User-agent: *
+ Disallow: /
+
+This is an example of a malformed robots.txt file.
+
+ # robots.txt for ancientcastle.example.com
+ # I've locked myself away.
+ User-agent: *
+ Disallow: /
+ # The castle is your home now, so you can go anywhere you like.
+ User-agent: Belle
+ Disallow: /west-wing/ # except the west wing!
+ # It's good to be the Prince...
+ User-agent: Beast
+ Disallow:
+
+This file is missing the required blank lines between records.
+However, the intention is clear.
+
+=head1 SEE ALSO
+
+L<LWP::RobotUA>, L<WWW::RobotRules::AnyDBM_File>
+
+=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.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/WWW/RobotRules/AnyDBM_File.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/WWW/RobotRules/AnyDBM_File.pm
new file mode 100644
index 0000000000..8daa68870f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/WWW/RobotRules/AnyDBM_File.pm
@@ -0,0 +1,170 @@
+package WWW::RobotRules::AnyDBM_File;
+
+require WWW::RobotRules;
+@ISA = qw(WWW::RobotRules);
+$VERSION = "6.00";
+
+use Carp ();
+use AnyDBM_File;
+use Fcntl;
+use strict;
+
+=head1 NAME
+
+WWW::RobotRules::AnyDBM_File - Persistent RobotRules
+
+=head1 SYNOPSIS
+
+ require WWW::RobotRules::AnyDBM_File;
+ require LWP::RobotUA;
+
+ # Create a robot useragent that uses a diskcaching RobotRules
+ my $rules = WWW::RobotRules::AnyDBM_File->new( 'my-robot/1.0', 'cachefile' );
+ my $ua = WWW::RobotUA->new( 'my-robot/1.0', 'me@foo.com', $rules );
+
+ # Then just use $ua as usual
+ $res = $ua->request($req);
+
+=head1 DESCRIPTION
+
+This is a subclass of I<WWW::RobotRules> that uses the AnyDBM_File
+package to implement persistent diskcaching of F<robots.txt> and host
+visit information.
+
+The constructor (the new() method) takes an extra argument specifying
+the name of the DBM file to use. If the DBM file already exists, then
+you can specify undef as agent name as the name can be obtained from
+the DBM database.
+
+=cut
+
+sub new
+{
+ my ($class, $ua, $file) = @_;
+ Carp::croak('WWW::RobotRules::AnyDBM_File filename required') unless $file;
+
+ my $self = bless { }, $class;
+ $self->{'filename'} = $file;
+ tie %{$self->{'dbm'}}, 'AnyDBM_File', $file, O_CREAT|O_RDWR, 0640
+ or Carp::croak("Can't open $file: $!");
+
+ if ($ua) {
+ $self->agent($ua);
+ }
+ else {
+ # Try to obtain name from DBM file
+ $ua = $self->{'dbm'}{"|ua-name|"};
+ Carp::croak("No agent name specified") unless $ua;
+ }
+
+ $self;
+}
+
+sub agent {
+ my($self, $newname) = @_;
+ my $old = $self->{'dbm'}{"|ua-name|"};
+ if (defined $newname) {
+ $newname =~ s!/?\s*\d+.\d+\s*$!!; # loose version
+ unless ($old && $old eq $newname) {
+ # Old info is now stale.
+ my $file = $self->{'filename'};
+ untie %{$self->{'dbm'}};
+ tie %{$self->{'dbm'}}, 'AnyDBM_File', $file, O_TRUNC|O_RDWR, 0640;
+ %{$self->{'dbm'}} = ();
+ $self->{'dbm'}{"|ua-name|"} = $newname;
+ }
+ }
+ $old;
+}
+
+sub no_visits {
+ my ($self, $netloc) = @_;
+ my $t = $self->{'dbm'}{"$netloc|vis"};
+ return 0 unless $t;
+ (split(/;\s*/, $t))[0];
+}
+
+sub last_visit {
+ my ($self, $netloc) = @_;
+ my $t = $self->{'dbm'}{"$netloc|vis"};
+ return undef unless $t;
+ (split(/;\s*/, $t))[1];
+}
+
+sub fresh_until {
+ my ($self, $netloc, $fresh) = @_;
+ my $old = $self->{'dbm'}{"$netloc|exp"};
+ if ($old) {
+ $old =~ s/;.*//; # remove cleartext
+ }
+ if (defined $fresh) {
+ $fresh .= "; " . localtime($fresh);
+ $self->{'dbm'}{"$netloc|exp"} = $fresh;
+ }
+ $old;
+}
+
+sub visit {
+ my($self, $netloc, $time) = @_;
+ $time ||= time;
+
+ my $count = 0;
+ my $old = $self->{'dbm'}{"$netloc|vis"};
+ if ($old) {
+ my $last;
+ ($count,$last) = split(/;\s*/, $old);
+ $time = $last if $last > $time;
+ }
+ $count++;
+ $self->{'dbm'}{"$netloc|vis"} = "$count; $time; " . localtime($time);
+}
+
+sub push_rules {
+ my($self, $netloc, @rules) = @_;
+ my $cnt = 1;
+ $cnt++ while $self->{'dbm'}{"$netloc|r$cnt"};
+
+ foreach (@rules) {
+ $self->{'dbm'}{"$netloc|r$cnt"} = $_;
+ $cnt++;
+ }
+}
+
+sub clear_rules {
+ my($self, $netloc) = @_;
+ my $cnt = 1;
+ while ($self->{'dbm'}{"$netloc|r$cnt"}) {
+ delete $self->{'dbm'}{"$netloc|r$cnt"};
+ $cnt++;
+ }
+}
+
+sub rules {
+ my($self, $netloc) = @_;
+ my @rules = ();
+ my $cnt = 1;
+ while (1) {
+ my $rule = $self->{'dbm'}{"$netloc|r$cnt"};
+ last unless $rule;
+ push(@rules, $rule);
+ $cnt++;
+ }
+ @rules;
+}
+
+sub dump
+{
+}
+
+1;
+
+=head1 SEE ALSO
+
+L<WWW::RobotRules>, L<LWP::RobotUA>
+
+=head1 AUTHORS
+
+Hakan Ardo E<lt>hakan@munin.ub2.lu.se>, Gisle Aas E<lt>aas@sn.no>
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API.pm
new file mode 100644
index 0000000000..e353e2eb32
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API.pm
@@ -0,0 +1,1474 @@
+# See the bottom of this file for the POD documentation. Search for the
+# string '=head'.
+
+#######################################################################
+#
+# Win32::API - Perl Win32 API Import Facility
+#
+# Author: Aldo Calpini <dada@perl.it>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+# Changes for gcc/cygwin: Daniel Risacher <magnus@alum.mit.edu>
+# ported from 0.41 based on Daniel's patch by Reini Urban <rurban@x-ray.at>
+#
+#######################################################################
+
+package Win32::API;
+ use strict;
+ use warnings;
+BEGIN {
+ require Exporter; # to export the constants to the main:: space
+
+ sub ISCYG ();
+ if($^O eq 'cygwin') {
+ BEGIN{warnings->unimport('uninitialized')}
+ die "Win32::API on Cygwin requires the cygpath tool on PATH"
+ if index(`cygpath --help`,'Usage: cygpath') == -1;
+ require File::Basename;
+ eval "sub ISCYG () { 1 }";
+ } else {
+ eval "sub ISCYG () { 0 }";
+ }
+
+
+ use vars qw( $DEBUG $sentinal @ISA @EXPORT_OK $VERSION );
+
+ @ISA = qw( Exporter );
+ @EXPORT_OK = qw( ReadMemory IsBadReadPtr MoveMemory
+ WriteMemory SafeReadWideCString ); # symbols to export on request
+
+ use Scalar::Util qw( looks_like_number weaken);
+
+ sub ERROR_NOACCESS () { 998 }
+ sub ERROR_NOT_ENOUGH_MEMORY () { 8 }
+ sub ERROR_INVALID_PARAMETER () { 87 }
+ sub APICONTROL_CC_STD () { 0 }
+ sub APICONTROL_CC_C () { 1 }
+ sub APICONTROL_CC_mask () { 0x7 }
+ sub APICONTROL_UseMI64 () { 0x8 }
+ sub APICONTROL_is_more () { 0x10 }
+ sub APICONTROL_has_proto() { 0x20 }
+ eval ' *Win32::API::Type::PTRSIZE = *Win32::API::More::PTRSIZE = *PTRSIZE = sub () { '.length(pack('p', undef)).' };'.
+ #Win64 added in 5.7.3
+ ' *Win32::API::Type::IVSIZE = *Win32::API::More::IVSIZE = *IVSIZE = sub () { '.length(pack($] >= 5.007003 ? 'J' : 'I' ,0)).' };'.
+ ' *Win32::API::Type::DEBUGCONST = *Win32::API::Struct::DEBUGCONST = *DEBUGCONST = sub () { '.(!!$DEBUG+0).' };'
+}
+
+sub DEBUG {
+ #checking flag redundant now, but keep in case of an accidental unprotected call
+ if ($Win32::API::DEBUG) {
+ printf @_ if @_ or return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+use Win32::API::Type ();
+use Win32::API::Struct ();
+
+#######################################################################
+# STATIC OBJECT PROPERTIES
+#
+#### some package-global hash to
+#### keep track of the imported
+#### libraries and procedures
+my %Libraries = ();
+my %Procedures = ();
+
+
+#######################################################################
+# dynamically load in the API extension module.
+# BEGIN required for constant subs in BOOT:
+BEGIN {
+ $VERSION = '0.84';
+ require XSLoader;
+ XSLoader::load 'Win32::API', $VERSION;
+}
+
+#######################################################################
+# PUBLIC METHODS
+#
+sub new {
+ die "Win32::API/More::new/Import is a class method that takes 2 to 6 parameters, see POD"
+ if @_ < 3 || @_ > 7;
+ my ($class, $dll, $hproc, $ccnum, $outnum) = (shift, shift);
+ if(! defined $dll){
+ $hproc = shift;
+ }
+ my ($proc, $in, $out, $callconvention) = @_;
+ my ($hdll, $freedll, $proto, $stackunwind) = (0, 0, 0, 0);
+ my $self = {};
+ if(! defined $hproc){
+ if (ISCYG() and $dll ne File::Basename::basename($dll)) {
+
+ # need to convert $dll to win32 path
+ # isn't there an API for this?
+ my $newdll = `cygpath -w "$dll"`;
+ chomp $newdll;
+ DEBUG "(PM)new: converted '$dll' to\n '$newdll'\n" if DEBUGCONST;
+ $dll = $newdll;
+ }
+
+ #### avoid loading a library more than once
+ if (exists($Libraries{$dll})) {
+ DEBUG "Win32::API::new: Library '$dll' already loaded, handle=$Libraries{$dll}\n" if DEBUGCONST;
+ $hdll = $Libraries{$dll};
+ }
+ else {
+ DEBUG "Win32::API::new: Loading library '$dll'\n" if DEBUGCONST;
+ $hdll = Win32::API::LoadLibrary($dll);
+ $freedll = 1;
+ # $Libraries{$dll} = $hdll;
+ }
+
+ #### if the dll can't be loaded, set $! to Win32's GetLastError()
+ if (!$hdll) {
+ $! = Win32::GetLastError();
+ DEBUG "FAILED Loading library '$dll': $^E\n" if DEBUGCONST;
+ return undef;
+ }
+ }
+ else{
+ if(!looks_like_number($hproc) || IsBadReadPtr($hproc, 4)){
+ Win32::SetLastError(ERROR_NOACCESS);
+ DEBUG "FAILED Function pointer '$hproc' is not a valid memory location\n" if DEBUGCONST;
+ return undef;
+ }
+ }
+ #### determine if we have a prototype or not, outtype is for future use in XS
+ if ((not defined $in) and (not defined $out)) {
+ ($proc, $self->{in}, $self->{intypes}, $outnum, $self->{outtype},
+ $ccnum) = parse_prototype($class, $proc);
+ if( ! $proc ){
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ Win32::SetLastError(ERROR_INVALID_PARAMETER);
+ return undef;
+ }
+ $proto = 1;
+ }
+ else {
+ $self->{in} = [];
+ my $self_in = $self->{in}; #avoid hash derefing
+ if (ref($in) eq 'ARRAY') {
+ foreach (@$in) {
+ push(@{$self_in}, $class->type_to_num($_));
+ }
+ }
+ else {
+ my @in = split '', $in;
+ foreach (@in) {
+ push(@{$self_in}, $class->type_to_num($_));
+ }
+ }#'V' must be one and ONLY letter for "in"
+ foreach(@{$self_in}){
+ if($_ == 0){
+ if(@{$self_in} != 1){
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ die "Win32::API 'V' for in prototype must be the only parameter";
+ } else {undef(@{$self_in});} #empty arr, as if in param was ""
+ }
+ }
+ $outnum = $class->type_to_num($out, 1);
+ $ccnum = calltype_to_num($callconvention);
+ }
+
+ if(!$hproc){ #if not non DLL func
+ #### first try to import the function of given name...
+ $hproc = Win32::API::GetProcAddress($hdll, $proc);
+
+ #### ...then try appending either A or W (for ASCII or Unicode)
+ if (!$hproc) {
+ my $tproc = $proc;
+ $tproc .= (IsUnicode() ? "W" : "A");
+
+ # print "Win32::API::new: procedure not found, trying '$tproc'...\n";
+ $hproc = Win32::API::GetProcAddress($hdll, $tproc);
+ }
+
+ #### ...if all that fails, give up, $! setting is back compat, $! is deprecated
+ if (!$hproc) {
+ my $err = $! = Win32::GetLastError();
+ DEBUG "FAILED GetProcAddress for Proc '$proc': $^E\n" if DEBUGCONST;
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ Win32::SetLastError($err);
+ return undef;
+ }
+ DEBUG "GetProcAddress('$proc') = '$hproc'\n" if DEBUGCONST;
+ }
+ else {
+ DEBUG "Using non-DLL function pointer '$hproc' for '$proc'\n" if DEBUGCONST;
+ }
+ if(PTRSIZE == 4 && $ccnum == APICONTROL_CC_C) {#fold out on WIN64
+ #calculate add to ESP amount, in units of 4, will be *4ed later
+ $stackunwind += $_ == T_QUAD || $_ == T_DOUBLE ? 2 : 1 for(@{$self->{in}});
+ if($stackunwind > 0xFFFF) {
+ goto too_many_in_params;
+ }
+ }
+ # if a prototype has 8 byte types on 32bit, $stackunwind will be higher than
+ # length of {in} letter array, so 2 different checks need to be done
+ if($#{$self->{in}} > 0xFFFF) {
+ too_many_in_params:
+ DEBUG "FAILED This function has too many parameters (> ~65535) \n" if DEBUGCONST;
+ Win32::API::FreeLibrary($hdll) if $freedll;
+ Win32::SetLastError(ERROR_NOT_ENOUGH_MEMORY);
+ return undef;
+ }
+ #### ok, let's stuff the object
+ $self->{procname} = $proc;
+ $self->{dll} = $hdll;
+ $self->{dllname} = $dll;
+
+ $outnum &= ~T_FLAG_NUMERIC;
+ my $control;
+ $self->{weakapi} = \$control;
+ weaken($self->{weakapi});
+ $control = pack( 'L'
+ .'L'
+ .(PTRSIZE == 8 ? 'Q' : 'L')
+ .(PTRSIZE == 8 ? 'Q' : 'L')
+ .(PTRSIZE == 8 ? 'Q' : 'L')
+ .(PTRSIZE == 8 ? '' : 'L')
+ ,($class eq "Win32::API::More" ? APICONTROL_is_more : 0)
+ | ($proto ? APICONTROL_has_proto : 0)
+ | $ccnum
+ | (PTRSIZE == 8 ? 0 : $stackunwind << 8)
+ | $outnum << 24
+ , scalar(@{$self->{in}}) * PTRSIZE #in param count, in SV * units
+ , $hproc
+ , \($self->{weakapi})+0 #weak api obj ref
+ , (exists $self->{intypes} ? ($self->{intypes})+0 : 0)
+ , 0); #padding to align to 8 bytes on 32 bit only
+ #align to 16 bytes
+ $control .= "\x00" x ((((length($control)+ 15) >> 4) << 4)-length($control));
+ #make a APIPARAM template array
+ my ($i, $arr_end) = (0, scalar(@{$self->{in}}));
+ for(; $i< $arr_end; $i++) {
+ my $tin = $self->{in}[$i];
+ #unsigned meaningless no sign vs zero extends are done bc uv/iv is
+ #the biggest native integer on the cpu, big to small is truncation
+ #numeric is implemented as T_NUMCHAR for in, keeps asm jumptable clean
+ $tin &= ~(T_FLAG_UNSIGNED|T_FLAG_NUMERIC);
+ $tin--; #T_VOID doesn't exist as in param in XS
+ #put index of param array slice in unused space for croaks, why not?
+ $control .= "\x00" x 8 . pack('CCSSS', $tin, 0, 0, $i, $i+1);
+ }
+ _Align($control, 16); #align the whole PVX to 16 bytes for SSE moves
+
+ #### keep track of the imported function
+ if(defined $dll){
+ $Libraries{$dll} = $hdll;
+ $Procedures{$dll}++;
+ }
+ DEBUG "Object blessed!\n" if DEBUGCONST;
+
+ my $ref = bless(\$control, $class);
+ SetMagicSV($ref, $self);
+ return $ref;
+}
+
+sub Import {
+ my $closure = shift->new(@_)
+ or return undef;
+ my $procname = ${Win32::API::GetMagicSV($closure)}{procname};
+ #dont allow "sub main:: {0;}"
+ Win32::SetLastError(ERROR_INVALID_PARAMETER), return undef if $procname eq '';
+ _ImportXS($closure, (caller)[0].'::'.$procname);
+ return $closure;
+}
+
+#######################################################################
+# PRIVATE METHODS
+#
+sub DESTROY {
+ my ($self) = GetMagicSV($_[0]);
+
+ return if ! defined $self->{dllname};
+ #### decrease this library's procedures reference count
+ $Procedures{$self->{dllname}}--;
+
+ #### once it reaches 0, free it
+ if ($Procedures{$self->{dllname}} == 0) {
+ DEBUG "Win32::API::DESTROY: Freeing library '$self->{dllname}'\n" if DEBUGCONST;
+ Win32::API::FreeLibrary($Libraries{$self->{dllname}});
+ delete($Libraries{$self->{dllname}});
+ }
+}
+
+# Convert calling convention string (_cdecl|__stdcall)
+# to a C const. Unknown counts as __stdcall
+#
+sub calltype_to_num {
+ my $type = shift;
+
+ if (!$type || $type eq "__stdcall" || $type eq "WINAPI" || $type eq "NTAPI"
+ || $type eq "CALLBACK" ) {
+ return APICONTROL_CC_STD;
+ }
+ elsif ($type eq "_cdecl" || $type eq "__cdecl" || $type eq "WINAPIV") {
+ return APICONTROL_CC_C;
+ }
+ else {
+ warn "unknown calling convention: '$type'";
+ return APICONTROL_CC_STD;
+ }
+}
+
+
+sub type_to_num {
+ die "wrong class" if shift ne "Win32::API";
+ my $type = shift;
+ my $out = shift;
+ my ($num, $numeric);
+ if(index($type, 'num', 0) == 0){
+ substr($type, 0, length('num'), '');
+ $numeric = 1;
+ }
+ else{
+ $numeric = 0;
+ }
+
+ if ( $type eq 'N'
+ or $type eq 'n'
+ or $type eq 'l'
+ or $type eq 'L'
+ or ( PTRSIZE == 8 and $type eq 'Q' || $type eq 'q'))
+ {
+ $num = T_NUMBER;
+ }
+ elsif ($type eq 'P'
+ or $type eq 'p')
+ {
+ $num = T_POINTER;
+ }
+ elsif ($type eq 'I'
+ or $type eq 'i')
+ {
+ $num = T_INTEGER;
+ }
+ elsif ($type eq 'f'
+ or $type eq 'F')
+ {
+ $num = T_FLOAT;
+ }
+ elsif ($type eq 'D'
+ or $type eq 'd')
+ {
+ $num = T_DOUBLE;
+ }
+ elsif ($type eq 'c'
+ or $type eq 'C')
+ {
+ $num = $numeric ? T_NUMCHAR : T_CHAR;
+ }
+ elsif (PTRSIZE == 4 and $type eq 'q' || $type eq 'Q')
+ {
+ $num = T_QUAD;
+ }
+ elsif($type eq '>'){
+ die "Win32::API does not support pass by copy structs as function arguments";
+ }
+ else {
+ $num = T_VOID; #'V' takes this branch, which is T_VOID in C
+ }#not valid return types of the C func
+ if(defined $out) {#b/B remains private/undocumented
+ die "Win32::API invalid return type, structs and ".
+ "callbacks as return types not supported"
+ if($type =~ m/^s|S|t|T|b|B|k|K$/);
+ }
+ else {#in type
+ if ($type eq 's' or $type eq 'S' or $type eq 't' or $type eq 'T')
+ {
+ $num = T_STRUCTURE;
+ }
+ elsif ($type eq 'b'
+ or $type eq 'B')
+ {
+ $num = T_POINTERPOINTER;
+ }
+ elsif ($type eq 'k'
+ or $type eq 'K')
+ {
+ $num = T_CODE;
+ }
+ }
+ $num |= T_FLAG_NUMERIC if $numeric;
+ return $num;
+}
+
+package Win32::API::More;
+
+use vars qw( @ISA );
+@ISA = qw ( Win32::API );
+sub type_to_num {
+ die "wrong class" if shift ne "Win32::API::More";
+ my $type = shift;
+ my $out = shift;
+ my ($num, $numeric);
+ if(index($type, 'num', 0) == 0){
+ substr($type, 0, length('num'), '');
+ $numeric = 1;
+ }
+ else{
+ $numeric = 0;
+ }
+
+ if ( $type eq 'N'
+ or $type eq 'n'
+ or $type eq 'l'
+ or $type eq 'L'
+ or ( PTRSIZE == 8 and $type eq 'Q' || $type eq 'q')
+ or (! $out and # in XS short 'in's are interger/numbers code
+ $type eq 'S'
+ || $type eq 's'))
+ {
+ $num = Win32::API::T_NUMBER;
+ if(defined $out && ($type eq 'N' || $type eq 'L'
+ || $type eq 'S' || $type eq 'Q')){
+ $num |= Win32::API::T_FLAG_UNSIGNED;
+ }
+ }
+ elsif ($type eq 'P'
+ or $type eq 'p')
+ {
+ $num = Win32::API::T_POINTER;
+ }
+ elsif ($type eq 'I'
+ or $type eq 'i')
+ {
+ $num = Win32::API::T_INTEGER;
+ if(defined $out && $type eq 'I'){
+ $num |= Win32::API::T_FLAG_UNSIGNED;
+ }
+ }
+ elsif ($type eq 'f'
+ or $type eq 'F')
+ {
+ $num = Win32::API::T_FLOAT;
+ }
+ elsif ($type eq 'D'
+ or $type eq 'd')
+ {
+ $num = Win32::API::T_DOUBLE;
+ }
+ elsif ($type eq 'c'
+ or $type eq 'C')
+ {
+ $num = $numeric ? Win32::API::T_NUMCHAR : Win32::API::T_CHAR;
+ if(defined $out && $type eq 'C'){
+ $num |= Win32::API::T_FLAG_UNSIGNED;
+ }
+ }
+ elsif (PTRSIZE == 4 and $type eq 'q' || $type eq 'Q')
+ {
+ $num = Win32::API::T_QUAD;
+ if(defined $out && $type eq 'Q'){
+ $num |= Win32::API::T_FLAG_UNSIGNED;
+ }
+ }
+ elsif ($type eq 's') #4 is only used for out params
+ {
+ $num = Win32::API::T_SHORT;
+ }
+ elsif ($type eq 'S')
+ {
+ $num = Win32::API::T_SHORT | Win32::API::T_FLAG_UNSIGNED;
+ }
+ elsif($type eq '>'){
+ die "Win32::API does not support pass by copy structs as function arguments";
+ }
+ else {
+ $num = Win32::API::T_VOID; #'V' takes this branch, which is T_VOID in C
+ } #not valid return types of the C func
+ if(defined $out) {#b/B remains private/undocumented
+ die "Win32::API invalid return type, structs and ".
+ "callbacks as return types not supported"
+ if($type =~ m/^t|T|b|B|k|K$/);
+ }
+ else {#in type
+ if ( $type eq 't'
+ or $type eq 'T')
+ {
+ $num = Win32::API::T_STRUCTURE;
+ }
+ elsif ($type eq 'b'
+ or $type eq 'B')
+ {
+ $num = Win32::API::T_POINTERPOINTER;
+ }
+ elsif ($type eq 'k'
+ or $type eq 'K')
+ {
+ $num = Win32::API::T_CODE;
+ }
+ }
+ $num |= Win32::API::T_FLAG_NUMERIC if $numeric;
+ return $num;
+}
+package Win32::API;
+
+sub parse_prototype {
+ my ($class, $proto) = @_;
+
+ my @in_params = ();
+ my @in_types = (); #one day create a BNF-ish formal grammer parser here
+ if ($proto =~ /^\s*((?:(?:un|)signed\s+|) #optional signedness
+ \S+)(?:\s*(\*)\s*|\s+) #type and maybe a *
+ (?:(\w+)\s+)? # maybe a calling convention
+ (\S+)\s* #func name
+ \(([^\)]*)\) #param list
+ /x) {
+ my $ret = $1.(defined($2)?$2:'');
+ my $callconvention = $3;
+ my $proc = $4;
+ my $params = $5;
+
+ $params =~ s/^\s+//;
+ $params =~ s/\s+$//;
+
+ DEBUG "(PM)parse_prototype: got PROC '%s'\n", $proc if DEBUGCONST;
+ DEBUG "(PM)parse_prototype: got PARAMS '%s'\n", $params if DEBUGCONST;
+
+ foreach my $param (split(/\s*,\s*/, $params)) {
+ my ($type, $name);
+ #match "in_t* _var" "in_t * _var" "in_t *_var" "in_t _var" "in_t*_var" supported
+ #unsigned or signed or nothing as prefix supported
+ # "in_t ** _var" and "const in_t* var" not supported
+ if ($param =~ /((?:(?:un|)signed\s+|)\w+)(?:\s*(\*)\s*|\s+)(\w+)/) {
+ ($type, $name) = ($1.(defined($2)? $2:''), $3);
+ }
+ {
+ BEGIN{warnings->unimport('uninitialized')}
+ if($type eq '') {goto BADPROTO;} #something very wrong, bail out
+ }
+ my $packing = Win32::API::Type::packing($type);
+ if (defined $packing && $packing ne '>') {
+ if (Win32::API::Type::is_pointer($type)) {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type,
+ $packing,
+ $class->type_to_num('P') if DEBUGCONST;
+ push(@in_params, $class->type_to_num('P'));
+ }
+ else {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type,
+ $packing,
+ $class->type_to_num(Win32::API::Type->packing($type, undef, 1)) if DEBUGCONST;
+ push(@in_params, $class->type_to_num(Win32::API::Type->packing($type, undef, 1)));
+ }
+ }
+ elsif (Win32::API::Struct::is_known($type)) {
+ DEBUG "(PM)parse_prototype: IN='%s' PACKING='%s' API_TYPE=%d\n",
+ $type, 'T', Win32::API::More->type_to_num('T') if DEBUGCONST;
+ push(@in_params, Win32::API::More->type_to_num('T'));
+ }
+ else {
+ warn
+ "Win32::API::parse_prototype: WARNING unknown parameter type '$type'";
+ push(@in_params, $class->type_to_num('I'));
+ }
+ push(@in_types, $type);
+
+ }
+ DEBUG "parse_prototype: IN=[ @in_params ]\n" if DEBUGCONST;
+
+
+ if (Win32::API::Type::is_known($ret)) {
+ if (Win32::API::Type::is_pointer($ret)) {
+ DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
+ $ret,
+ Win32::API::Type->packing($ret),
+ $class->type_to_num('P') if DEBUGCONST;
+ return ($proc, \@in_params, \@in_types, $class->type_to_num('P', 1),
+ $ret, calltype_to_num($callconvention));
+ }
+ else {
+ DEBUG "parse_prototype: OUT='%s' PACKING='%s' API_TYPE=%d\n",
+ $ret,
+ Win32::API::Type->packing($ret),
+ $class->type_to_num(Win32::API::Type->packing($ret, undef, 1), 1) if DEBUGCONST;
+ return (
+ $proc, \@in_params, \@in_types,
+ $class->type_to_num(Win32::API::Type->packing($ret, undef, 1), 1),
+ $ret, calltype_to_num($callconvention)
+ );
+ }
+ }
+ else {
+ warn
+ "Win32::API::parse_prototype: WARNING unknown output parameter type '$ret'";
+ return ($proc, \@in_params, \@in_types, $class->type_to_num('I', 1),
+ $ret, calltype_to_num($callconvention));
+ }
+
+ }
+ else {
+ BADPROTO:
+ warn "Win32::API::parse_prototype: bad prototype '$proto'";
+ return undef;
+ }
+}
+
+#
+# XXX hack, see the proper implementation in TODO
+# The point here is don't let fork children free the parent's DLLs.
+# CLONE runs on ::API and ::More, that's bad and causes a DLL leak, make sure
+# CLONE dups the DLL handles only once per CLONE
+# GetModuleHandleEx was not used since that is a WinXP and newer function, not Win2K.
+# GetModuleFileName was used to get full DLL pathname incase SxS/multiple DLLs
+# with same file name exist in the process. Even if the dll was loaded as a
+# relative path initially, later SxS can load a DLL with a different full path
+# yet same file name, and then LoadLibrary'ing the original relative path
+# might increase the refcount on the wrong DLL or return a different HMODULE
+sub CLONE {
+ return if $_[0] ne "Win32::API";
+
+ _my_cxt_clone();
+ foreach( keys %Libraries){
+ if($Libraries{$_} != Win32::API::LoadLibrary(Win32::API::GetModuleFileName($Libraries{$_}))){
+ die "Win32::API::CLONE unable to clone DLL \"$Libraries{$_}\" Unicode Problem??";
+ }
+ }
+}
+
+1;
+
+__END__
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API - Perl Win32 API Import Facility
+
+=head1 SYNOPSIS
+
+ #### Method 1: with prototype
+
+ use Win32::API;
+ $function = Win32::API::More->new(
+ 'mydll', 'int sum_integers(int a, int b)'
+ );
+ #### $^E is non-Cygwin only
+ die "Error: $^E" if ! $function;
+ #### or on Cygwin and non-Cygwin
+ die "Error: ".(Win32::FormatMessage(Win32::GetLastError())) if ! $function;
+ ####
+ $return = $function->Call(3, 2);
+
+ #### Method 2: with prototype and your function pointer
+
+ use Win32::API;
+ $function = Win32::API::More->new(
+ undef, 38123456, 'int name_ignored(int a, int b)'
+ );
+ die "Error: $^E" if ! $function; #$^E is non-Cygwin only
+ $return = $function->Call(3, 2);
+
+ #### Method 3: with parameter list
+
+ use Win32::API;
+ $function = Win32::API::More->new(
+ 'mydll', 'sum_integers', 'II', 'I'
+ );
+ die "Error: $^E" if ! $function; #$^E is non-Cygwin only
+ $return = $function->Call(3, 2);
+
+ #### Method 4: with parameter list and your function pointer
+
+ use Win32::API;
+ $function = Win32::API::More->new(
+ undef, 38123456, 'name_ignored', 'II', 'I'
+ );
+ die "Error: $^E" if ! $function; #$^E is non-Cygwin only
+ $return = $function->Call(3, 2);
+
+ #### Method 5: with Import (slightly faster than ->Call)
+
+ use Win32::API;
+ $function = Win32::API::More->Import(
+ 'mydll', 'int sum_integers(int a, int b)'
+ );
+ die "Error: $^E" if ! $function; #$^E is non-Cygwin only
+ $return = sum_integers(3, 2);
+
+
+=for LATER-UNIMPLEMENTED
+ #### or
+ use Win32::API mydll => 'int sum_integers(int a, int b)';
+ $return = sum_integers(3, 2);
+
+
+=head1 ABSTRACT
+
+With this module you can import and call arbitrary functions
+from Win32's Dynamic Link Libraries (DLL) or arbitrary functions for
+which you have a pointer (MS COM, etc), without having
+to write an XS extension. Note, however, that this module
+can't do everything. In fact, parameters input and output is
+limited to simpler cases.
+
+A regular B<XS> extension is always safer and faster anyway.
+
+The current version of Win32::API is always available at your
+nearest CPAN mirror:
+
+ http://search.cpan.org/dist/Win32-API/
+
+A short example of how you can use this module (it just gets the PID of
+the current process, eg. same as Perl's internal C<$$>):
+
+ use Win32::API;
+ Win32::API::More->Import("kernel32", "int GetCurrentProcessId()");
+ $PID = GetCurrentProcessId();
+
+Starting with 0.69. Win32::API initiated objects are deprecated due to numerous
+bugs and improvements, use Win32::API::More now. The use statement remains
+as C<use Win32::API;>.
+
+The possibilities are nearly infinite (but not all are good :-).
+Enjoy it.
+
+=head1 DESCRIPTION
+
+To use this module put the following line at the beginning of your script:
+
+ use Win32::API;
+
+You can now use the C<new()> function of the Win32::API module to create a
+new Win32::API::More object (see L<IMPORTING A FUNCTION>) and then invoke the
+C<Call()> method on this object to perform a call to the imported API
+(see L<CALLING AN IMPORTED FUNCTION>).
+
+Starting from version 0.40, you can also avoid creating a Win32::API::More object
+and instead automatically define a Perl sub with the same name of the API
+function you're importing. This 2nd way using C<Import> to create a sub instead
+of an object is slightly faster than doing C<-E<gt>Call()>. The details of the
+API definitions are the same, just the method name is different:
+
+ my $GetCurrentProcessId = Win32::API::More->new(
+ "kernel32", "int GetCurrentProcessId()"
+ );
+ die "Failed to import GetCurrentProcessId" if !$GetCurrentProcessId;
+ $GetCurrentProcessId->UseMI64(1);
+ my $PID = $GetCurrentProcessId->Call();
+
+ #### vs.
+
+ my $UnusedGCPI = Win32::API::More->Import("kernel32", "int GetCurrentProcessId()");
+ die "Failed to import GetCurrentProcessId" if !$UnusedGCPI;
+ $UnusedGCPI->UseMI64(1);
+ $PID = GetCurrentProcessId();
+
+Note that C<Import> returns the Win32::API obj on success and false on failure
+(in which case you can check the content of C<$^E>). This allows some settings
+to be set through method calls that can't be specified as a parameter to Import,
+yet still have the convience of not writing C<-E<gt>Call()>. The Win32::API obj
+does not need to be assigned to a scalar. C<unless(Win32::API::More-E<gt>Import>
+is fine. Prior to v0.76_02, C<Import> returned returned 1 on success and 0 on
+failure.
+
+=head2 IMPORTING A FUNCTION
+
+You can import a function from a 32 bit Dynamic Link Library (DLL) file with
+the C<new()> function or, starting in 0.69, supply your own function pointer.
+This will create a Perl object that contains the reference to that function,
+which you can later C<Call()>.
+
+What you need to know is the prototype of the function you're going to import
+(eg. the definition of the function expressed in C syntax).
+
+Starting from version 0.40, there are 2 different approaches for this step:
+(the preferred) one uses the prototype directly, while the other (now deprecated)
+one uses Win32::API's internal representation for parameters.
+
+=head2 IMPORTING A FUNCTION BY PROTOTYPE
+
+You need to pass 2 or 3 parameters:
+
+=over 4
+
+=item 1.
+
+The name of the library from which you want to import the function. If the
+name is undef, you are requesting a object created from a function pointer,
+and must supply item 2.
+
+=item 2.
+
+This parameter is optional, most people should skip it, skip does not mean
+supplying undef. Supply a function pointer in the format of number 1234, not
+string "\x01\x02\x03\x04". Undef will be returned if the pointer is not
+readable, L<Win32::GetLastError|Win32/Win32::GetLastError()>/L<perlvar/"$^E">
+will be C<ERROR_NOACCESS>.
+
+=item 3.
+
+The C prototype of the function. If you are using a function pointer, the name
+of the function should be something "friendly" to you and no attempt is made
+to retrieve such a name from any DLL's export table. This name for a function
+pointer is also used for Import().
+
+=back
+
+When calling a function imported with a prototype, if you pass an
+undefined Perl scalar to one of its arguments, it will be
+automatically turned into a C C<NULL> value.
+
+See L<Win32::API::Type> for a list of the known parameter types and
+L<Win32::API::Struct> for information on how to define a structure.
+
+If a prototype type is exactly C<signed char> or C<unsigned char> for an
+"in" parameter or the return parameter, and for "in" parameters only
+C<signed char *> or C<unsigned char *> the parameters will be treated as a
+number, C<0x01>, not C<"\x01">. "UCHAR" is not "unsigned char". Change the
+C prototype if you want numeric handling for your chars.
+
+=head2 IMPORTING A FUNCTION WITH A PARAMETER LIST
+
+You need to pass at minimum 4 parameters.
+
+=over 4
+
+=item 1.
+The name of the library from which you want to import the function.
+
+=item 2.
+This parameter is optional, most people should skip it, skip does not mean
+supplying undef. Supply a function pointer in the format of number C<1234>,
+not string C<"\x01\x02\x03\x04">. Undef will be returned if the pointer is not
+readable, L<Win32::GetLastError|Win32/Win32::GetLastError()>/L<perlvar/"$^E">
+will be C<ERROR_NOACCESS>.
+
+=item 3.
+The name of the function (as exported by the library) or for function pointers
+a name that is "friendly" to you. This name for a function pointer is also used
+for Import(). No attempt is made to retrieve such a name from any DLL's export
+table in the 2nd case.
+
+=item 4.
+The number and types of the arguments the function expects as input.
+
+=item 5.
+The type of the value returned by the function.
+
+=item 6.
+And optionally you can specify the calling convention, this defaults to
+'__stdcall', alternatively you can specify '_cdecl' or '__cdecl' (API > v0.68)
+or (API > v0.70_02) 'WINAPI', 'NTAPI', 'CALLBACK' (__stdcall), 'WINAPIV' (__cdecl) .
+False is __stdcall. Vararg functions are always cdecl. MS DLLs are typically
+stdcall. Non-MS DLLs are typically cdecl. If API > v0.75, mixing up the calling
+convention on 32 bits is detected and Perl will C<croak> an error message and
+C<die>.
+
+=back
+
+To better explain their meaning, let's suppose that we
+want to import and call the Win32 API C<GetTempPath()>.
+This function is defined in C as:
+
+ DWORD WINAPI GetTempPathA( DWORD nBufferLength, LPSTR lpBuffer );
+
+This is documented in the B<Win32 SDK Reference>; you can look
+for it on the Microsoft's WWW site, or in your C compiler's
+documentation, if you own one.
+
+=over 4
+
+=item B<1.>
+
+The first parameter is the name of the library file that
+exports this function; our function resides in the F<KERNEL32.DLL>
+system file.
+
+When specifying this name as parameter, the F<.DLL> extension
+is implicit, and if no path is given, the file is searched through
+a couple of directories, including:
+
+=over 4
+
+=item 1. The directory from which the application loaded.
+
+=item 2. The current directory.
+
+=item 3. The Windows system directory (eg. c:\windows\system or system32).
+
+=item 4. The Windows directory (eg. c:\windows).
+
+=item 5. The directories that are listed in the PATH environment variable.
+
+=back
+
+You may, but don't have to write F<C:\windows\system\kernel32.dll>; or
+F<kernel32.dll>, only F<kernel32> is enough:
+
+ $GetTempPath = new Win32::API::More('kernel32', ...
+
+=item B<2.>
+
+Since this function is from a DLL, skip the 2nd parameter. Skip does not
+mean supplying undef.
+
+=item B<3.>
+
+Now for the real second parameter: the name of the function.
+It must be written exactly as it is exported
+by the library (case is significant here).
+If you are using Windows 95 or NT 4.0, you can use the B<Quick View>
+command on the DLL file to see the function it exports.
+Remember that you can only import functions from 32 or 64 bit DLLs:
+in Quick View, the file's characteristics should report
+somewhere "32 bit word machine"; as a rule of thumb,
+when you see that all the exported functions are in upper case,
+the DLL is a 16 bit one and you can't use it. You also can not load a 32 bit
+DLL into a 64 bit Perl, or vice versa. If you try, C<new>/C<Import> will fail
+and C<$^E> will be C<ERROR_BAD_EXE_FORMAT>.
+If their capitalization looks correct, then it's probably a 32 bit
+DLL. If you have Platform SDK or Visual Studio, you can use the Dumpbin
+tool. Call it as C<dumpbin /exports name_of_dll.dll> on the command line.
+If you have Mingw GCC, use objdump as
+C<objdump -x name_of_dll.dll E<gt> dlldump.txt> and search for the word exports
+in the very long output.
+
+Also note that many Win32 APIs are exported twice, with the addition of
+a final B<A> or B<W> to their name, for - respectively - the ASCII
+and the Unicode version.
+When a function name is not found, Win32::API will actually append
+an B<A> to the name and try again; if the extension is built on a
+Unicode system, then it will try with the B<W> instead.
+So our function name will be:
+
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', ...
+
+In our case C<GetTempPath> is really loaded as C<GetTempPathA>.
+
+=item B<4.>
+
+The third parameter, the input parameter list, specifies how many
+arguments the function wants, and their types. It can be passed as
+a single string, in which each character represents one parameter,
+or as a list reference. The following forms are valid:
+
+ "abcd"
+ [a, b, c, d]
+ \@LIST
+
+But those are not:
+
+ (a, b, c, d)
+ @LIST
+
+The number of characters, or elements in the list, specifies the number
+of parameters, and each character or element specifies the type of an
+argument; allowed types are:
+
+=over 4
+
+=item C<I>:
+value is an unsigned integer (unsigned int)
+
+=item C<i>:
+value is an signed integer (signed int or int)
+
+=item C<N>:
+value is a unsigned pointer sized number (unsigned long)
+
+=item C<n>:
+value is a signed pointer sized number (signed long or long)
+
+=item C<Q>:
+value is a unsigned 64 bit integer number (unsigned long long, unsigned __int64)
+See next item for details.
+
+=item C<q>:
+value is a signed 64 bit integer number (long long, __int64)
+If your perl has 'Q'/'q' quads support for L<perlfunc/pack> then Win32::API's 'q'
+is a normal perl numeric scalar. All 64 bit Perls have quad support. Almost no
+32 bit Perls have quad support. On 32 bit Perls, without quad support,
+Win32::API's 'q'/'Q' letter is a packed 8 byte string. So C<0x8000000050000000>
+from a perl with native Quad support would be written as
+C<"\x00\x00\x00\x50\x00\x00\x00\x80"> on a 32 bit Perl without Quad support.
+To improve the use of 64 bit integers with Win32::API on a 32 bit Perl without
+Quad support, there is a per Win32::API::* object setting called L</UseMI64>
+that causes all quads to be accepted as, and returned as L<Math::Int64> objects.
+For "in" params in Win32::API and Win32::API::More and "out" in
+Win32::API::Callback only, if the argument is a reference, it will automatically
+be treated as a Math::Int64 object without having to previously call
+L</UseMI64>.
+
+=item C<F>:
+value is a single precision (4 bytes) floating point number (float)
+
+=item C<D>:
+value is a double precision (8 bytes) floating point number (double)
+
+=item C<S>:
+value is a unsigned short (unsigned short)
+
+=item C<s>:
+value is a signed short (signed short or short)
+
+=item C<C>:
+value is a char (char), pass as C<"a">, not C<97>, C<"abc"> will truncate to C<"a">
+
+=item C<P>:
+value is a pointer (to a string, structure, etc...)
+padding out the buffer string is required, buffer overflow detection is
+performed. Pack and unpack the data yourself. If P is a return type, only
+null terminated strings or NULL pointer are supported. If P is an in type, NULL
+is integer C<0>. C<undef>, C<"0">, and C<""+0> are not integer C<0>, C<"0"+0> is
+integer C<0>.
+
+It is suggested to
+not use P as a return type and instead use N and read the memory yourself, and
+free the pointer if applicable. This pointer is effectively undefined after the
+C function returns control to Perl. The C function may not hold onto it after
+the C function returns control. There are exceptions where the pointer will
+remain valid after the C function returns control, but tread at your own risk,
+and at your knowledge of Perl interpreter's C internals.
+
+=item C<T>:
+value is a Win32::API::Struct object, in parameter only, pass by reference
+(pointer) only, pass by copy not implemented, see other sections for more
+
+=item C<K>:
+value is a Win32::API::Callback object, in parameter only, (see L<Win32::API::Callback>)
+
+=item C<V>:
+no value, no parameters, stands for C<void>, may not be combined with any other
+letters, equivalent to a ""
+
+=back
+
+For beginners, just skip this paragraph.
+Note, all parameter types are little endian. This is probably what you want
+unless the documentation for the C function you are calling explicitly says
+the parameters must be big endian. If there is no documentation for your C
+function or no mention of endianess in the documentation, this doesn't apply
+to you and skip the rest of this paragraph. There is no inherent support
+for big endian parameters. Perl's scalar numbers model is that numeric
+scalars are effectively opaque and their machine representation is
+irrelevant. On Windows Perl, scalar numbers are little endian
+internally. So C<$number = 5; print "$number";> will put 5 on the screen.
+C<$number> given to Win32::API will pass little endian integer 5 to the C
+function call. This is almost surly what you want. If you really must pass
+a big endian integer, do C<$number = unpack('L', pack('N', 5));>, then
+C<print "$number";> will put 83886080 on the screen, but this is big endian 5,
+and passing 83886080 to C<-E<gt>Call()> will make sure that
+the C function is getting big endian 5. See L<perlpacktut> for more.
+
+Our function needs two parameters: a number (C<DWORD>) and a pointer to a
+string (C<LPSTR>):
+
+ $GetTempPath = new Win32::API('kernel32', 'GetTempPath', 'NP', ...
+
+=item B<4.>
+
+The fourth is the type of the value returned by the
+function. It can be one of the types seen above, plus another type named B<V>
+(for C<void>), used for functions that do not return a value.
+In our example the value returned by GetTempPath() is a C<DWORD>, which is a
+typedef for unsigned long, so our return type will be B<N>:
+
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', 'NP', 'N');
+
+Now the line is complete, and the GetTempPath() API is ready to be used
+in Perl. Before calling it, you should test that $GetTempPath is
+L<perlfunc/defined>, otherwise errors such as the function or the library could
+not be loaded or the C prototype was unparsable happened, and no object was
+created. If the return value is undefined, to get detailed error status, use
+L<perlvar/"$^E"> or L<Win32::GetLastError|Win32/Win32::GetLastError()>. C<$^E>
+is slower than C<Win32::GetLastError> and useless on Cygwin, but C<$^E> in
+string context provides a readable description of the error. In numeric context,
+C<$^E> is equivelent to C<Win32::GetLastError>. C<Win32::GetLastError> always
+returns an integer error code. You may use
+L<Win32::FormatMessage|Win32/Win32::FormatMessage()> to convert an integer error
+code to a readable description on Cygwin and Native builds of Perl.
+
+Our definition, with error checking added, should then look like this:
+
+ $GetTempPath = new Win32::API::More('kernel32', 'GetTempPath', 'NP', 'N');
+ if(not defined $GetTempPath) {
+ die "Can't import API GetTempPath: $^E\n";
+ }
+
+=back
+
+=head2 CALLING AN IMPORTED FUNCTION
+
+To effectively make a call to an imported function you must use the
+Call() method on the Win32::API object you created.
+Continuing with the example from the previous paragraph,
+the GetTempPath() API can be called using the method:
+
+ $GetTempPath->Call(...
+
+Of course, parameters have to be passed as defined in the import phase.
+In particular, if the number of parameters does not match (in the example,
+if GetTempPath() is called with more or less than two parameters),
+Perl will C<croak> an error message and C<die>.
+
+The two parameters needed here are the length of the buffer
+that will hold the returned temporary path, and a pointer to the
+buffer itself.
+For numerical parameters except for char, you can use either a constant expression
+or a variable, it will be numified similar to the expression C<($var+0)>.
+For pointers, also note that B<memory must be allocated before calling the function>,
+just like in C.
+For example, to pass a buffer of 80 characters to GetTempPath(),
+it must be initialized before with:
+
+ $lpBuffer = " " x 80;
+
+This allocates a string of 80 characters. If you don't do so, you'll
+probably get a fatal buffer overflow error starting in 0.69.
+The call should therefore include:
+
+ $lpBuffer = " " x 80;
+ $GetTempPath->Call(80, $lpBuffer);
+
+And the result will be stored in the $lpBuffer variable.
+Note that you never need to pass a reference to the variable
+(eg. you B<don't need> C<\$lpBuffer>), even if its value will be set
+by the function.
+
+A little problem here is that Perl does not trim the variable,
+so $lpBuffer will still contain 80 characters in return; the exceeding
+characters will be spaces, because we said C<" " x 80>.
+
+In this case we're lucky enough, because the value returned by
+the GetTempPath() function is the length of the string, so to get
+the actual temporary path we can write:
+
+ $lpBuffer = " " x 80;
+ $return = $GetTempPath->Call(80, $lpBuffer);
+ $TempPath = substr($lpBuffer, 0, $return);
+
+If you don't know the length of the string, you can usually
+cut it at the C<\0> (ASCII zero) character, which is the string
+delimiter in C:
+
+ $TempPath = ((split(/\0/, $lpBuffer))[0];
+ # or
+ $lpBuffer =~ s/\0.*$//;
+
+=head2 USING STRUCTURES
+
+Starting from version 0.40, Win32::API comes with a support package
+named Win32::API::Struct. The package is loaded automatically with
+Win32::API, so you don't need to use it explicitly.
+
+With this module you can conveniently define structures and use
+them as parameters to Win32::API functions. A short example follows:
+
+
+ # the 'POINT' structure is defined in C as:
+ # typedef struct {
+ # LONG x;
+ # LONG y;
+ # } POINT;
+
+
+ #### define the structure
+ Win32::API::Struct->typedef( POINT => qw{
+ LONG x;
+ LONG y;
+ });
+
+ #### import an API that uses this structure
+ Win32::API->Import('user32', 'BOOL GetCursorPos(LPPOINT lpPoint)');
+
+ #### create a 'POINT' object
+ my $pt = Win32::API::Struct->new('POINT');
+
+ #### call the function passing our structure object
+ GetCursorPos($pt);
+
+ #### and now, access its members
+ print "The cursor is at: $pt->{x}, $pt->{y}\n";
+
+Note that this works only when the function wants a
+B<pointer to a structure>, not a "pass by copy" structure. As you can see, our
+structure is named 'POINT', but the API used 'LPPOINT'. Some heuristics are
+done to validate the argument's type vs the parameter's type if the function
+has a C prototype definition (not letter definition). First, if the parameter
+type starts with the LP prefix, the LP prefix is stripped, then compared to
+the argument's type. If that fails, the Win32::API::Type database
+(see L<Win32::API::Type/typedef>)
+will be used to convert the parameter type to the base type. If that fails,
+the parameter type will be stripped of a trailing whitespace then a '*', and
+then checked against the base type. L<Dies|perlfunc/die> if the parameter and
+argument types do not match after 3 attempts.
+
+For more information, see also L<Win32::API::Struct>.
+
+If you don't want (or can't) use the C<Win32::API::Struct> facility,
+you can still use the low-level approach to use structures:
+
+=over 4
+
+=item 1.
+
+you have to L<pack()|perlfunc/pack> the required elements in a variable:
+
+ $lpPoint = pack('ll', 0, 0); # store two LONGs
+
+=item 2.
+
+to access the values stored in a structure, L<unpack()|perlfunc/unpack> it as required:
+
+ ($x, $y) = unpack(';;', $lpPoint); # get the actual values
+
+=back
+
+The rest is left as an exercise to the reader...
+
+=head2 EXPORTED FUNCTIONS
+
+=head3 ReadMemory
+
+ $copy_of_memblock = ReadMemory($SourcePtr, $length);
+
+Reads the source pointer for C<$length> number of bytes. Returns a copy of
+the memory block in a scalar. No readability checking is done on C<$SourcePtr>.
+C<$SourcePtr>'s format is 123456, not C<"\x01\x02\x03\x04">.
+
+=head3 WriteMemory
+
+ WriteMemory($DestPtr, $sourceScalar, $length);
+
+Copies the string contents of the C<$sourceScalar> scalar to C<$DestPtr> for
+C<$length> bytes. $length must be less than or equal to the length of
+C<$sourceScalar>, otherwise the function croaks. No readability checking is
+done on C<$DestPtr>. C<$DestPtr>'s format is 123456, not
+C<"\x01\x02\x03\x04">. Returns nothing.
+
+=head3 MoveMemory
+
+ MoveMemory($destPtr, $sourcePtr, $length);
+
+Copies a block of memory from one location to another. The source and
+destination blocks may overlap. All pointers are in the format of 123456,
+not C<"\x01\x02\x03\x04">. No readability checking is done. Returns nothing.
+
+=head3 IsBadReadPtr
+
+ if(IsBadReadPtr($ptr, $length)) {die "bad ptr";}
+
+Probes a memory block for C<$length> bytes for readability. Returns true if
+access violation occurs, otherwise false is returned. This function is useful
+to avoid dereferencing pointers which will crash the perl process. This function
+has many limitations, including not detecting uninitialized memory, not
+detecting freed memory, and not detecting gibberish. It can not tell whether a
+function pointer is valid x86 machine code. Ideally, you should never use it,
+or remove it once your code is stable. C<$ptr> is in the format of 123456,
+not C<"\x01\x02\x03\x04">. See MS's documentation for a lot more
+on this function of the same name.
+
+=head3 SafeReadWideCString
+
+ $source = Encode::encode("UTF-16LE","Just another perl h\x{00E2}cker\x00");
+ $string = SafeReadWideCString(unpack('J',pack('p', $source)));
+ die "impossible" if $source ne "Just another perl h\x{00E2}cker";
+
+Safely (SEH aware) reads a utf-16 wide null terminated string (the first and
+only parameter), into a scalar. Returns undef, if an access violation happens
+or null pointer (same thing). The string pointer is in the format of 123456,
+not C<"\x01\x02\x03\x04">. The returned scalar will be UTF8 marked if the string
+can not be represented in the system's ANSI codepage. Conversion is done with
+WideCharToMultiByte. Returns a 0 length scalar string if WideCharToMultiByte fails.
+This function was created because L<pack's|perlfunc/pack> p letter won't read UTF16
+and L</ReadMemory> and L</IsBadReadPtr> require an explicit length.
+
+=head2 CONSTRUCTORS
+
+=head3 new
+
+ $obj = Win32::API::More->new([$dllname | (undef , $funcptr)], [$c_proto | ($in, $out [, $calling_convention])]);
+
+See L</DESCRIPTION>.
+
+=head3 Import
+ $obj = Win32::API::More->Import([$dllname | (undef , $funcptr)], [$c_proto | ($in, $out [, $calling_convention])]);
+
+See L</DESCRIPTION>.
+
+=head2 METHODS
+
+=head3 Call
+
+The main method of a Win32::API object. Documented elsewhere in this document.
+
+=head3 UseMI64
+
+ $bool = $APIObj->UseMI64();
+ $oldbool = $APIObj->UseMI64($newbool);
+
+Turns on Quads as L<Math::Int64> objects support for a particular object
+instance. You must call L<perlfunc/use>/L<perlfunc/require> on Math::Int64
+before calling UseMI64. Win32::API does not C<use> Math::Int64 for you.
+Works on Win32::API and Win32::API::Callback objects. This method
+does not exist if your Perl natively supports Quads (64 bit Perl for example).
+Takes 1 optional parameter, which is a true or false value to use or don't use
+Math::Int64, returns the old setting, which is a true or false value. If called
+without any parameters, returns current setting, which is a true or false value,
+without setting the option. As discussed in L</q>, if you are not using
+Math::Int64 you must supply/will receive 8 byte scalar strings for quads.
+For "in" params in Win32::API and Win32::API::More and "out" in
+Win32::API::Callback only, if the argument is a reference, it will automatically
+be treated as a Math::Int64 object without having to previously call this
+function.
+
+=head2 VERBOSE DEBUGGING
+
+If using C<Win32::GetLastError> and C<$^E> does not reveal the problem with your
+use of Win32::API, you may turn on Win32::API's very verbose debugging mode as
+follows
+
+ BEGIN {
+ $Win32::API::DEBUG = 1;
+ }
+ use Win32::API;
+ $function = Win32::API::More->new(
+ 'mydll', 'int sum_integers(int a, int b)'
+ );
+
+=head1 HISTORY
+
+=over 4
+
+=item UseMI64 API change
+
+Starting in 0.71, UseMI64 on a set returns old value, not previously
+new value.
+
+=item fork safe
+
+Starting in 0.71, a Win32::API object can go through a fork and work
+correctly in the child and parent psuedo-processes. Previously when either
+psuedo-processes exited, the DLL would be unloaded and the other
+psuedo-processes would crash if a Call() was done on the object.
+
+=item return value signedness
+
+Prior to 0.69, for numeric integer types, the return scalar was always signed.
+Unsigned-ness was ignored.
+
+=item shorts
+
+Prior to 0.69, shorts were not supported. 'S' meant a sturct. To fix this
+Win32::API::More class was created for 0.69. 'S'/'s' now means short, per pack's
+letters. Struct has been moved to letter 'T'. Win32::API will continue to exist
+for legacy code.
+
+=item float return types
+
+Prior to 0.69, if a function had a return type of float, it was silently
+not called.
+
+=item buffer overflow protection
+
+Introduced in 0.69. If disabling is required, which is highly
+B<not recommended>, set an environmental variable called
+WIN32_API_SORRY_I_WAS_AN_IDIOT to 1.
+
+=item automatic un/pack
+
+Starting with 0.69, when using Win32::API::More, there is automatic un/packing
+of pointers to numbers-ish things for in parameters when using the C
+prototype interface.
+
+=item Quads on 32 bit
+
+Added in 0.70.
+
+=item __stdcall vs __cdecl checking on 32 bits
+
+Added in 0.76_01
+
+=item Import returns an api obj on success, undef on failure, instead of 1 or 0
+
+Added in 0.76_02
+
+=item checking C<$!> for C<new>/C<Import> failure is broken and deprecated
+
+Starting in 0.76_06, due to many bugs with C<new> and C<Import> not setting
+L<perlvar/$!> or Win32 and C error codes overlapping and Win32 error codes being
+stringified as different C error codes, checking C<$!> is deprecated and the
+existing, partial setting of C<$!>, maybe removed in the future. Only check
+C<Win32::GetLastError()> or C<$^E> to find out why the call failed.
+
+=back
+
+See the C<Changes> file for more details, many of which not mentioned here.
+
+=head1 BUGS AND LIMITATIONS
+
+=over 4
+
+=item E<nbsp> Unicode DLL paths
+
+Untested.
+
+=item E<nbsp> ithreads
+
+Minimally tested.
+
+=item E<nbsp> C functions getting utf8 scalars vs byte scalars
+
+Untested and undefined.
+
+=back
+
+=head1 SEE ALSO
+
+L<Math::Int64>
+
+L<Win32::API::Struct>
+
+L<Win32::API::Type>
+
+L<Win32::API::Callback>
+
+L<Win32::API::Callback::IATPatch>
+
+L<http://homepage.ntlworld.com/jonathan.deboynepollard/FGA/function-calling-conventions.html>
+
+=head1 AUTHOR
+
+Aldo Calpini ( I<dada@perl.it> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> )
+
+=head1 MAJOR CONTRIBUTOR
+
+Daniel Dragan ( I<bulkdd@cpan.org> )
+
+=head1 LICENSE
+
+To finally clarify this, C<Win32::API> is OSI-approved free software;
+you can redistribute it and/or modify it under the same terms as Perl
+itself.
+
+See L<http://dev.perl.org/licenses/artistic.html>
+
+=head1 CREDITS
+
+All the credits go to Andrea Frosini for the neat assembler trick
+that makes this thing work. I've also used some work by Dave Roth
+for the prototyping stuff. A big thank you also to Gurusamy Sarathy
+for his invaluable help in XS development, and to all the Perl
+community for being what it is.
+
+Cosimo also wants to personally thank everyone that contributed
+to Win32::API with complaints, emails, patches, RT bug reports
+and so on.
+
+=cut
+
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Callback.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Callback.pm
new file mode 100644
index 0000000000..1731a637fb
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Callback.pm
@@ -0,0 +1,575 @@
+# See the bottom of this file for the POD documentation. Search for the
+# string '=head'.
+
+#######################################################################
+#
+# Win32::API::Callback - Perl Win32 API Import Facility
+#
+# Author: Aldo Calpini <dada@perl.it>
+# Author: Daniel Dragan <bulkdd@cpan.org>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+#######################################################################
+
+package Win32::API::Callback;
+use strict;
+use warnings;
+use vars qw( $VERSION $Stage2FuncPtrPkd );
+
+$VERSION = '0.84';
+
+#require XSLoader; # to dynuhlode the module. #already loaded by Win32::API
+#use Data::Dumper;
+
+use Win32::API qw ( WriteMemory ) ;
+
+BEGIN {
+ #there is supposed to be 64 bit IVs on 32 bit perl compatibility here
+ #but it is untested
+ *IVSIZE = *Win32::API::IVSIZE;
+ #what kind of stack processing/calling convention/machine code we needed
+ eval "sub ISX64 () { ".(Win32::API::PTRSIZE() == 8 ? 1 : 0)." }";
+ eval 'sub OPV () {'.$].'}';
+ sub OPV();
+ sub CONTEXT_XMM0();
+ sub CONTEXT_RAX();
+ *IsBadStringPtr = *Win32::API::IsBadStringPtr;
+ sub PTRSIZE ();
+ *PTRSIZE = *Win32::API::PTRSIZE;
+ sub PTRLET ();
+ *PTRLET = *Win32::API::Type::pointer_pack_type;
+ if(OPV <= 5.008000){ #don't have unpackstring in C
+ eval('sub _CallUnpack {return unpack($_[0], $_[1]);}');
+ }
+ *DEBUGCONST = *Win32::API::DEBUGCONST;
+ *DEBUG = *Win32::API::DEBUG;
+}
+#######################################################################
+# dynamically load in the API extension module.
+#
+XSLoader::load 'Win32::API::Callback', $VERSION;
+
+#######################################################################
+# PUBLIC METHODS
+#
+sub new {
+ my ($class, $proc, $in, $out, $callconvention) = @_;
+ my $self = bless {}, $class; #about croak/die safety, can safely bless here,
+ #a ::Callback has no DESTROY, it has no resources to release, there is a HeapBlock obj
+ #stored in the ::Callback hash, but the HeapBlock destroys on its own
+ # printf "(PM)Callback::new: got proc='%s', in='%s', out='%s'\n", $proc, $in, $out;
+
+ $self->{intypes} = []; #XS requires this, do not remove
+ if (ref($in) eq 'ARRAY') {
+ foreach (@$in) {
+ push(@{$self->{intypes}}, $_);
+ }
+ }
+ else {
+ my @in = split '', $in;
+ foreach (@in) {
+ push(@{$self->{intypes}}, $_);
+ }
+ }
+ $self->{inbytes} = 0;
+ foreach(@{$self->{intypes}}){ #calc how long the c stack is
+ if($_ eq 'Q' or $_ eq 'q' or $_ eq 'D' or $_ eq 'd'){
+ $self->{inbytes} += 8; #always 8
+ }
+ else{
+ $self->{inbytes} += PTRSIZE; #4 or 8
+ }
+ }
+ $self->{outtype} = $out;
+ $self->{out} = Win32::API->type_to_num($out);
+ $self->{sub} = $proc;
+ $self->{cdecl} = Win32::API::calltype_to_num($callconvention);
+
+ DEBUG "(PM)Callback::new: calling CallbackCreate($self)...\n" if DEBUGCONST;
+ my $hproc = MakeCB($self);
+
+ DEBUG "(PM)Callback::new: hproc=$hproc\n" if DEBUGCONST;
+
+ $self->{code} = $hproc;
+
+ #### cast the spell
+ return $self;
+}
+
+sub MakeStruct {
+ my ($self, $n, $addr) = @_;
+ DEBUG "(PM)Win32::API::Callback::MakeStruct: got self='$self'\n" if DEBUGCONST;
+ my $struct = Win32::API::Struct->new($self->{intypes}->[$n]);
+ $struct->FromMemory($addr);
+ return $struct;
+}
+
+#this was rewritten in XS, and is broken b/c it doesn't work on 32bit Perl with Quads
+#sub MakeParamArr { #on x64, never do "$i++; $packedparam .= $arr->[$i];"
+# #on x86, structs and over word size params appears on the stack,
+# #on x64 anything over the size of a "word" is passed by pointer
+# #nothing takes more than 8 bytes per parameter on x64
+# #there is no way to formally specify a pass by copy struct in ::Callback
+# #this only matters on x86, a work around is a bunch of N/I parameters,
+# #repack them as Js, then concat them, and you have the original pass by copy
+# #x86 struct
+# my ($self, $arr) = @_;
+# my ($i, @pass_arr) = (0);
+# for(@{$self->{intypes}}){ #elements of intypes are not 1 to 1 with stack params
+# my ($typeletter, $packedparam, $finalParam, $unpackletter) = ($_, $arr->[$i]);
+#
+# #structs don't work, this is broken code from old version
+# #$self->{intypes} is letters types not C prototype params
+# #C prototype support would have to exist for MakeStruct to work
+# if( $typeletter eq 'S' || $typeletter eq 's'){
+# die "Win32::API::Callback::MakeParamArr type letter \"S\" and struct support not implemented";
+# #push(@pass_arr, MakeStruct($self, $i, $packedparam));
+# }elsif($typeletter eq 'I'){
+# $unpackletter = 'I', goto UNPACK;
+# }elsif($typeletter eq 'i'){
+# $unpackletter = 'i', goto UNPACK;
+# }elsif($typeletter eq 'f' || $typeletter eq 'F'){
+# $unpackletter = 'f', goto UNPACK;
+# }
+# elsif($typeletter eq 'd' || $typeletter eq 'D'){
+# if(IVSIZE == 4){ #need more data, 32 bit machine
+# $packedparam .= $arr->[++$i];
+# }
+# $unpackletter = 'd', goto UNPACK;
+# }
+# elsif($typeletter eq 'N' || $typeletter eq 'L' #on x64, J is 8 bytes
+# || (IVSIZE == 8 ? $typeletter eq 'Q': 0)){
+# $unpackletter = 'J', goto UNPACK;
+# }elsif($typeletter eq 'n' || $typeletter eq 'l'
+# || (IVSIZE == 8 ? $typeletter eq 'q': 0)){
+# $unpackletter = 'j', goto UNPACK;
+# }elsif(IVSIZE == 4 && ($typeletter eq 'q' || $typeletter eq 'Q')){
+# #need more data, 32 bit machine
+# $finalParam = $packedparam . $arr->[++$i];
+# }elsif($typeletter eq 'p' || $typeletter eq 'P'){
+# if(!IsBadStringPtr($arr->[$i], ~0)){ #P letter is terrible design
+# $unpackletter = 'p', goto UNPACK;
+# }#else undef
+# }
+# else{ die "Win32::API::Callback::MakeParamArr unknown in type letter $typeletter";}
+# goto GOTPARAM;
+# UNPACK:
+# $finalParam = unpack($unpackletter, $packedparam);
+# GOTPARAM:
+# $i++;
+# push(@pass_arr, $finalParam);
+# }
+# return \@pass_arr;
+#}
+
+#on x64
+#void RunCB($self, $EBP_ESP, $retval)
+#on x86
+#void RunCB($self, $EBP_ESP, $retval, $unwindcount, $F_or_D)
+if(! ISX64 ) {
+*RunCB = sub {#32 bits
+ my $self = $_[0];
+ my (@pass_arr, $return, $typeletter, $inbytes, @arr);
+ $inbytes = $self->{inbytes};
+ #first is ebp copy then ret address
+ $inbytes += PTRSIZE * 2;
+ my $paramcount = $inbytes / PTRSIZE ;
+ my $stackstr = unpack('P'.$inbytes, pack(PTRLET, $_[1]));
+ #pack () were added in 5.7.2
+ if (OPV > 5.007002) {
+ @arr = unpack("(a[".PTRLET."])[$paramcount]",$stackstr);
+ } else {
+ #letter can not be used for size, must be numeric on 5.6
+ @arr = unpack(("a4") x $paramcount,$stackstr);
+ }
+ shift @arr, shift @arr; #remove ebp copy and ret address
+ $paramcount -= 2;
+ $return = &{$self->{sub}}(@{MakeParamArr($self, \@arr)});
+
+ #now the return type
+ $typeletter = $self->{outtype};
+ #float_or_double flag, its always used
+ #float is default for faster copy of probably unused value
+ $_[4] = 0;
+ #its all the same in memory
+ if($typeletter eq 'n' || $typeletter eq 'N'
+ || $typeletter eq 'l' || $typeletter eq 'L'
+ || $typeletter eq 'i' || $typeletter eq 'I'){
+ $_[2] = pack(PTRLET, $return);
+ }elsif($typeletter eq 'q' || $typeletter eq 'Q'){
+ if(IVSIZE == 4){
+ if($self->{'UseMI64'} || ref($return)){ #un/signed meaningless
+ $_[2] = Math::Int64::int64_to_native($return);
+ }
+ else{
+ warn("Win32::API::Callback::RunCB return value for return type Q is under 8 bytes long")
+ if length($return) < 8;
+ $_[2] = $return.''; #$return should be a 8 byte string
+ #will be garbage padded in XS if < 8, but must be a string, not a IV or under
+ }
+ }
+ else{
+ $_[2] = pack($typeletter, $return);
+ }
+ }elsif($typeletter eq 'f' || $typeletter eq 'F' ){
+ $_[2] = pack('f', $return);
+ }elsif($typeletter eq 'd' || $typeletter eq 'D' ){
+ $_[2] = pack('d', $return);
+ $_[4] = 1; #use double
+ }else { #return null
+ $_[2] = "\x00" x 8;
+ }
+
+ if(! $self->{cdecl}){
+ $_[3] = PTRSIZE * $paramcount; #stack rewind amount in bytes
+ }
+ else{$_[3] = 0;}
+};
+}
+else{ #64 bits
+*RunCB = sub {
+ my $self = $_[0];
+ my (@pass_arr, $return, $typeletter);
+ my $paramcount = $self->{inbytes} / IVSIZE;
+ my $stack_ptr = unpack('P[J]', pack('J', ($_[1]+CONTEXT_RAX())));
+ my $stack_str = unpack('P['.$self->{inbytes}.']', $stack_ptr);
+ my @stack_arr = unpack("(a[J])[$paramcount]",$stack_str);
+ #not very efficient, todo search for f/F/d/D in new() not here
+ my $XMMStr = unpack('P['.(4 * 16).']', pack('J', ($_[1]+CONTEXT_XMM0())));
+ #print Dumper([unpack('(H[32])[4]', $XMMStr)]);
+ my @XMM = unpack('(a[16])[4]', $XMMStr);
+ #assume registers are copied to shadow stack space already
+ #because of ... prototype, so only XMM registers need to be fetched.
+ #Limitation, vararg funcs on x64 get floating points in normal registers
+ #not XMMs, so a vararg function taking floats and doubles in the first 4
+ #parameters isn't supported
+ if($paramcount){
+ for(0..($paramcount > 4 ? 4 : $paramcount)-1){
+ my $typeletter = ${$self->{intypes}}[$_];
+ if($typeletter eq 'f' || $typeletter eq 'F' || $typeletter eq 'd'
+ || $typeletter eq 'D'){
+ #x64 calling convention does not use the high 64 bits of a XMM register
+ #although right here the high 64 bits are in @XMM elements
+ #J on x64 is 8 bytes, a double will not corrupt, this is unreachable on x86
+ #note we are copying 16 bytes elements to @stack_arr, @stack_arr is
+ #normally 8 byte elements, unpack ignores the excess bytes later
+ $stack_arr[$_] = $XMM[$_];
+ }
+ }
+ }
+ #print Dumper(\@stack_arr);
+ #print Dumper(\@XMM);
+ $return = &{$self->{sub}}(@{MakeParamArr($self, \@stack_arr)});
+
+ #now the return type
+ $typeletter = $self->{outtype};
+ #its all the same in memory
+ if($typeletter eq 'n' || $typeletter eq 'N'
+ || $typeletter eq 'l' || $typeletter eq 'L'
+ || $typeletter eq 'i' || $typeletter eq 'I'
+ || $typeletter eq 'q' || $typeletter eq 'Q'){
+ $_[2] = pack('J', $return);
+ }
+ elsif($typeletter eq 'f' || $typeletter eq 'F' ){
+ $_[2] = pack('f', $return);
+ }
+ elsif($typeletter eq 'd' || $typeletter eq 'D' ){
+ $_[2] = pack('d', $return);
+ }
+ else { #return null
+ $_[2] = pack('J', 0);
+ }
+};
+}
+
+sub MakeCB{
+
+ my $self = $_[0];
+ #this x86 function does not corrupt the callstack in a debugger since it
+ #uses ebp and saves ebp on the stack, the function won't have a pretty
+ #name though
+ my $code = (!ISX64) ? ('' #parenthesis required to constant fold
+ ."\x55" # push ebp
+ ."\x8B\xEC" # mov ebp, esp
+ ."\x83\xEC\x0C"# sub esp, 0Ch
+ ."\x8D\x45\xFC" # lea eax, [ebp+FuncRtnCxtVar]
+ ."\x50"# push eax
+ ."\x8D\x45\xF4"# lea eax, [ebp+retval]
+ ."\x50"# push eax
+ ."\x8B\xC5"# mov eax,ebp
+ ."\x50"# push eax
+ ."\xB8").PackedRVTarget($self)#B8 mov imm32 to eax, a HV * winds up here
+ .("\x50"# push eax
+ ."\xB8").$Stage2FuncPtrPkd # mov eax, 0C0DE0001h
+ .("\xFF\xD0"# call eax
+ #since ST(0) is volatile, we don't care if we fill it with garbage
+ ."\x80\x7D\xFE\x00"#cmp [ebp+FuncRtnCxtVar.F_Or_D], 0
+ ."\xDD\xD8"# fstp st(0) pop a FP reg to make space on FPU stack
+ ."\x74\x05"# jz 5 bytes
+ ."\xDD\x45\xF4"# fld qword ptr [ebp+retval] (double)
+ ."\xEB\x03"# jmp 3 bytes
+ ."\xD9\x45\xF4"# fld dword ptr [ebp+retval] (float)
+ #rewind sp to entry sp, no pop push after this point
+ ."\x83\xC4\x24"# add esp, 24h
+ ."\x8B\x45\xF4"# mov eax, dword ptr [ebp+retval]
+ #edx might be garbage, we don't care, caller only looks at volatile
+ #registers that the caller's prototype says the caller does
+ ."\x8B\x55\xF8"# mov edx, dword ptr [ebp+retval+4]
+ #can't use retn op, it requires a immediate count, our count is in a register
+ #only one register available now, this will be complicated
+ ."\x0F\xB7\x4D\xFC"#movzx ecx, word ptr [ebp+FuncRtnCxtVar.unwind_len]
+ ."\x01\xCC"# add esp, ecx , might be zero or more
+ ."\x8B\x4D\x04"# mov ecx, dword ptr [ebp+4] ret address
+ ."\x8B\x6D\x00"# mov ebp, dword ptr [ebp+0] restore BP
+ ."\xFF\xE1")# jmp ecx
+
+
+ #begin x64 part
+ #these packs don't constant fold in < 5.17 :-(
+ #they are here for readability
+ :(''.pack('C', 0b01000000 #REX base
+ | 0b00001000 #REX.W
+ | 0b00000001 #REX.B
+ ).pack('C', 0xB8+2) #mov to r10 register
+ .PackedRVTarget($self)
+ .pack('C', 0b01000000 #REX base
+ | 0b00001000 #REX.W
+ ).pack('C', 0xB8) #mov to rax register
+ .$Stage2FuncPtrPkd
+ ."\xFF\xE0");# jmp rax
+#making a full function in Perl in x64 was removed because RtlAddFunctionTable
+#has no effect on VS 2008 debugger, it is a bug in VS 2008, in WinDbg the C callstack
+#is correct with RtlAddFunctionTable, and broken without RtlAddFunctionTable
+#in VS 2008, the C callstack was always broken since WinDbg and VS 2008 both
+#*only* use Unwind Tables on x64 to calculate C callstacks, they do not, I think,
+#use 32 bit style EBP/RBP walking, x64 VC almost never uses BP addressing anyway.
+#The easiest fix was to not have dynamic machine code in the callstack at all,
+#which is what I did. Having good C callstacks in a debugger with ::API and
+#::Callback are a good goal.
+#
+##--- c:\documents and settings\administrator\desktop\w32api\callback\callback.c -
+# $code .= "\x4C\x8B\xDC";# mov r11,rsp
+# $code .= "\x49\x89\x4B\x08";# mov qword ptr [r11+8],rcx
+# $code .= "\x49\x89\x53\x10";# mov qword ptr [r11+10h],rdx
+# $code .= "\x4D\x89\x43\x18";# mov qword ptr [r11+18h],r8
+# $code .= "\x4D\x89\x4B\x20";# mov qword ptr [r11+20h],r9
+# $code .= "\x48\x83\xEC\x78";# sub rsp,78h
+# #void (*LPerlCallback)(SV *, void *, unsigned __int64 *, void *) =
+# #( void (*)(SV *, void *, unsigned __int64 *, void *)) 0xC0DE00FFFF000001;
+# #__m128 arr [4];
+# #__m128 retval;
+## arr[0].m128_u64[0] = 0xFFFF00000000FF10;
+##00000000022D1017 48 B8 10 FF 00 00 00 00 FF FF mov rax,0FFFF00000000FF10h
+##arr[0].m128_u64[1] = 0xFFFF00000000FF11;
+## arr[1].m128_u64[0] = 0xFFFF00000000FF20;
+## arr[1].m128_u64[1] = 0xFFFF00000000FF21;
+## arr[2].m128_u64[0] = 0xFFFF00000000FF30;
+## arr[2].m128_u64[1] = 0xFFFF00000000FF31;
+## arr[3].m128_u64[0] = 0xFFFF00000000FF40;
+## arr[3].m128_u64[1] = 0xFFFF00000000FF41;
+#
+## LPerlCallback((SV *)0xC0DE00FFFF000002, (void*) arr, (unsigned __int64 *)&retval,
+## (DWORD_PTR)&a);
+##00000000022D1021 4D 8D 4B 08 lea r9,[r11+8] #no 4th param
+# $code .= "\x4D\x8D\x43\xA8";# lea r8,[r11-58h] #&retval param
+##00000000022D1029 49 89 43 B8 mov qword ptr [r11-48h],rax
+##00000000022D102D 48 B8 11 FF 00 00 00 00 FF FF mov rax,0FFFF00000000FF11h
+# $code .= "\x49\x8D\x53\xB8";# lea rdx,[r11-48h] #arr param
+##00000000022D103B 49 89 43 C0 mov qword ptr [r11-40h],rax
+##00000000022D103F 48 B8 20 FF 00 00 00 00 FF FF mov rax,0FFFF00000000FF20h
+##00000000022D1049 48 B9 02 00 00 FF FF 00 DE C0 mov rcx,0C0DE00FFFF000002h
+# $code .= "\x48\xB9".PackedRVTarget($self);# mov rcx, the HV *
+##00000000022D1053 49 89 43 C8 mov qword ptr [r11-38h],rax
+##00000000022D1057 48 B8 21 FF 00 00 00 00 FF FF mov rax,0FFFF00000000FF21h
+##00000000022D1061 49 89 43 D0 mov qword ptr [r11-30h],rax
+##00000000022D1065 48 B8 30 FF 00 00 00 00 FF FF mov rax,0FFFF00000000FF30h
+##00000000022D106F 49 89 43 D8 mov qword ptr [r11-28h],rax
+##00000000022D1073 48 B8 31 FF 00 00 00 00 FF FF mov rax,0FFFF00000000FF31h
+##00000000022D107D 49 89 43 E0 mov qword ptr [r11-20h],rax
+##00000000022D1081 48 B8 40 FF 00 00 00 00 FF FF mov rax,0FFFF00000000FF40h
+##00000000022D108B 49 89 43 E8 mov qword ptr [r11-18h],rax
+##00000000022D108F 48 B8 41 FF 00 00 00 00 FF FF mov rax,0FFFF00000000FF41h
+##00000000022D1099 49 89 43 F0 mov qword ptr [r11-10h],rax
+##00000000022D109D 48 B8 01 00 00 FF FF 00 DE C0 mov rax,0C0DE00FFFF000001h
+# $code .= "\x48\xB8".$Stage2FuncPtrPkd; # mov rax,0C0DE00FFFF000001h
+# $code .= "\xFF\xD0";# call rax
+## return *(void **)&retval;
+# $code .= "\x48\x8B\x44\x24\x20";# mov rax,qword ptr [retval]
+##}
+# $code .= "\x48\x83\xC4\x78";# add rsp,78h
+# $code .= "\xC3";# ret
+
+#$self->{codestr} = $code; #save memory
+#32 bit perl doesn't use DEP in my testing, but use executable heap to be safe
+#a Win32::API::Callback::HeapBlock is a ref to scalar, that scalar has the void *
+my $ptr = ${($self->{codeExecAlloc} = Win32::API::Callback::HeapBlock->new(length($code)))};
+WriteMemory($ptr, $code, length($code));
+return $ptr;
+}
+
+
+1;
+
+__END__
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API::Callback - Callback support for Win32::API
+
+=head1 SYNOPSIS
+
+ use Win32::API;
+ use Win32::API::Callback;
+
+ my $callback = Win32::API::Callback->new(
+ sub { my($a, $b) = @_; return $a+$b; },
+ "NN", "N",
+ );
+
+ Win32::API->Import(
+ 'mydll', 'two_integers_cb', 'KNN', 'N',
+ );
+
+ $sum = two_integers_cb( $callback, 3, 2 );
+
+
+=head1 FOREWORDS
+
+=over 4
+
+=item *
+Support for this module is B<highly experimental> at this point.
+
+=item *
+I won't be surprised if it doesn't work for you.
+
+=item *
+Feedback is very appreciated.
+
+=item *
+Documentation is in the work. Either see the SYNOPSIS above
+or the samples in the F<samples> or the tests in the F<t> directory.
+
+=back
+
+=head1 USAGE
+
+Win32::API::Callback uses a subset of the type letters of Win32::API. C Prototype
+interface isn't supported. Not all the type letters of Win32::API are supported
+in Win32::API::Callback.
+
+=over 4
+
+=item C<I>:
+value is an unsigned integer (unsigned int)
+
+=item C<i>:
+value is an signed integer (signed int or int)
+
+=item C<N>:
+value is a unsigned pointer sized number (unsigned long)
+
+=item C<n>:
+value is a signed pointer sized number (signed long or long)
+
+=item C<Q>:
+value is a unsigned 64 bit integer number (unsigned long long, unsigned __int64)
+See next item for details.
+
+=item C<q>:
+value is a signed 64 bit integer number (long long, __int64)
+If your perl has 'Q'/'q' quads support for L<pack> then Win32::API's 'q'
+is a normal perl numeric scalar. All 64 bit Perls have quad support. Almost no
+32 bit Perls have quad support. On 32 bit Perls, without quad support,
+Win32::API::Callback's 'q'/'Q' letter is a packed 8 byte string.
+So C<0x8000000050000000> from a perl with native Quad support
+would be written as C<"\x00\x00\x00\x50\x00\x00\x00\x80"> on a 32 bit
+Perl without Quad support. To improve the use of 64 bit integers with
+Win32::API::Callback on a 32 bit Perl without Quad support, there is
+a per Win32::API::Callback object setting called L<Win32::API/UseMI64>
+that causes all quads to be accepted as, and returned as L<Math::Int64>
+objects. 4 to 8 byte long pass by copy/return type C aggregate types
+are very rare in Windows, but they are supported as "in" and return
+types by using 'q'/'Q' on 32 and 64 bits. Converting between the C aggregate
+and its representation as a quad is up to the reader. For "out" in
+Win32::API::Callback (not "in"), if the argument is a reference, it will
+automatically be treated as a Math::Int64 object without having to
+previously call this function.
+
+=item C<F>:
+value is a floating point number (float)
+
+=item C<D>:
+value is a double precision number (double)
+
+=item C<Unimplemented types>:
+Unimplemented in Win32::API::Callback types such as shorts, chars, and
+smaller than "machine word size" (32/64bit) numbers can be processed
+by specifying N, then masking off the high bytes.
+For example, to get a char, specify N, then do C<$numeric_char = $_[2] & 0xFF;>
+in your Perl callback sub. To get a short, specify N, then do
+C<$numeric_char = $_[2] & 0xFFFF;> in your Perl callback sub.
+
+=back
+
+=head2 FUNCTIONS
+
+=head3 new
+
+ $CallbackObj = Win32::API::Callback->new( sub { print "hello world";},
+ 'NDF', 'Q', '__cdecl');
+ $CallbackObj = Win32::API::Callback->new( sub { print "hello world";},
+ $in, $out);
+
+Creates and returns a new Win32::API::Callback object. Calling convention
+parameter is optional. Calling convention parameter has same behaviour as
+Win32::API's calling convention parameter. C prototype parsing of Win32::API
+is not available with Win32::API::Callback. If the C caller assumes the
+callback has vararg parameters, and the platform is 64 bits/x64, in the first 4
+parameters, if they are floats or doubles they will be garbage. Note there is
+no way to create a Win32::API::Callback callback with a vararg prototype.
+A workaround is to put "enough" Ns as the in types, and stop looking at the @_
+slices in your Perl sub callback after a certain count. Usually the first
+parameter will somehow indicate how many additional stack parameters you are
+receiving. The Ns in @_ will eventually become garbage, technically they are
+the return address, saved registers, and C stack allocated variables of the
+caller. They are effectivly garbage for your vararg callback. All vararg
+callbacks on 32 bits must supply a calling convention, and it must be '__cdecl'
+or 'WINAPIV'.
+
+=head2 METHODS
+
+=head3 UseMI64
+
+See L<Win32::API/UseMI64>.
+
+=head1 KNOWN ISSUES
+
+=over 4
+
+=item *
+
+Callback is safe across a Win32 psuedo-fork. Callback is not safe across a
+Cygwin fork. On Cygwin, in the child process of the fork, a Segmentation Fault
+will happen if the Win32::API::Callback callback is is called.
+
+=back
+
+=head1 SEE ALSO
+
+L<Win32::API::Callback::IATPatch>
+
+=head1 AUTHOR
+
+Aldo Calpini ( I<dada@perl.it> ).
+Daniel Dragan ( I<bulkdd@cpan.org> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> ).
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Callback/IATPatch.pod b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Callback/IATPatch.pod
new file mode 100644
index 0000000000..27eb1af2fb
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Callback/IATPatch.pod
@@ -0,0 +1,181 @@
+=head1 NAME
+
+Win32::API::Callback::IATPatch - Hooking and Patching a DLL's Imported C Functions
+
+=head1 SYNOPSIS
+
+ use Win32::API;
+ use Win32::API::Callback;
+ warn "usually fatally errors on Cygwin" if $^O eq 'cygwin';
+ # do not do a "use" or "require" on Win32::API::Callback::IATPatch
+ # IATPatch comes with Win32::API::Callback
+ my $LoadLibraryExA;
+ my $callback = Win32::API::Callback->new(
+ sub {
+ my $libname = unpack('p', pack('J', $_[0]));
+ print "got $libname\n";
+ return $LoadLibraryExA->Call($libname, $_[1], $_[2]);
+ },
+ 'NNI',
+ 'N'
+ );
+ my $patch = Win32::API::Callback::IATPatch->new(
+ $callback, "perl518.dll", 'kernel32.dll', 'LoadLibraryExA');
+ die "failed to create IATPatch Obj $^E" if ! defined $patch;
+ $LoadLibraryExA = Win32::API::More->new( undef, $patch->GetOriginalFunctionPtr(), '
+ HMODULE
+ WINAPI
+ LoadLibraryExA(
+ LPCSTR lpLibFileName,
+ HANDLE hFile,
+ DWORD dwFlags
+ );
+ ');
+ die "failed to make old function object" if ! defined $LoadLibraryExA;
+ require Encode;
+ #console will get a print of the dll filename now
+
+=head1 DESCRIPTION
+
+Win32::API::Callback::IATPatch allows you to hook a compile time dynamic linked
+function call from any DLL (or EXE, from now on all examples are from a DLL to
+another DLL, but from a EXE to a DLL is implied) in the Perl process, to a
+different DLL in the same Perl process, by placing a Win32::API::Callback object
+in between. This module does B<not> hook B<GetProcAddress> function calls. It
+also will not hook a function call from a DLL to another function in the same
+DLL. The function you want to hook B<must> appear in the B<import table> of the
+DLL you want to use the hook. Functions from delay loaded DLL have their own
+import table, it is different import table from the normal one IATPatch supports.
+IATPatch will not find a delay loaded function and will not patch it. The hook
+occurs at the caller DLL, not the callee DLL. This means your callback will be
+called from all the calls to a one function in different DLL from the one
+particular DLL the IATPatch object patched. The caller DLL is modified at
+runtime, in the Perl process where the IATPatch was created, not on disk,
+not globally among all processes. The callee or exporting DLL is NOT modified,
+so your hook callback will be called from the 1 DLL that you choose to hook with
+1 IATPatch object. You can create multiple IATPatch objects, one for each DLL in
+the Perl process that you want to call your callback and not the original
+destination function. If a new DLL is loaded into the process during runtime,
+you must create a new IATPatch object specifically targeting it. There may be a
+period from when the new DLL is loaded into the process, and when your Perl
+script creates IATPatch object, where calls from that new DLL goto the real
+destination function without hooking. If a DLL is unloaded, then reloaded into
+the process, you must call C<Unpatch(0)> method on the old IATPatch object, then
+create a new IATPatch object. IATPatch has no notification feature that a DLL
+is being loaded or unloaded from the process. Unless you completely control, and
+have the source code of the caller DLL, and understand all of the source code of
+that DLL, there is a high chance that you will B<NOT> hook all calls from that
+DLL to the destination function. If a call to the destination function is
+dangerous or unacceptable, do not use IATPatch. IATPatch is not Microsoft
+Detours or the like in any sense. Detours and its brethern will rewrite the
+machine code in the beginning of the destination function call, hooking all
+calls to that function call process wide, without exception.
+
+Why this module was created? So I could mock kernel32 functions to
+unit test Perl's C function calls to Kernel32.
+
+=head2 CONSTRUCTORS
+
+=head3 new
+
+ my $patch = Win32::API::Callback::IATPatch->new(
+ $A_Win32_API_Callback_Obj, $EXE_or_DLL_hmodule_or_name_to_hook,
+ $import_DLL_name, $import_function_name_or_ordinal);
+
+Creates a new IATPatch object. The Win32::API::Callback will be called as long
+as the IATPatch object exists. When an IATPatch object is DESTROYed, unless
+C<-E<gt>Unpatch(0)> is called first, the patch is undone and the original
+function is directly called from then on by that DLL. The DLL is not reference
+count saved by an IATPatch object, so it may be unloaded at any time. If it is
+unloaded you must call C<-E<gt>Unpatch(0)> before a DESTROY. Otherwise the DESTROY
+will croak when it tries to unpatch the DLL. The DLL to hook must be a valid
+PE file, while in memory. DLL and EXE "packers" can create invalid PE
+files that do load successfully into memory, but they are not full PE files in
+memory. On error, undef is returned and an error code is available through
+L<Win32::GetLastError|Win32/Win32::GetLastError()>/L<perlvar/"$^E">. The error code may be from either
+IATPatch directly, or from a Win32 call that IATPatch made. IATPatch objects
+do not go through a L<perlfunc/"fork"> onto the child interp. IATPatch is fork safe.
+
+The hook dll name can be one of 3 things, if the dllname is multiple things
+(a number and a string), the first format found in the following order is used.
+A string C<"123"> (a very strange DLL name BTW), this DLL is converted to DLL
+HMODULE with GetModuleHandle. If there are 2 DLLs with the same filename,
+refer to GetModuleHandle's
+L<MSDN documentation|http://msdn.microsoft.com/en-us/library/windows/desktop/ms683199%28v=vs.85%29.aspx>
+on what happens. Then if the
+DLL name is an integer C<123456>, it is interpreted as a HMODULE directly.
+If DLL name undefined, the file used to create the calling process will be
+patched (a .exe). Finally if the DLL name is defined, a fatal error croak occurs.
+It is best to use an HMODULE, since things like SxS can create multiple DLLs with
+the same name in the same process. How to get an HMODULE, you are on your own.
+
+C<$import_function_name_or_ordinal> can be one of 2 things. First it is checked if
+it is a string, if so, it is used as the function name to hook. Else it is used
+as an integer ordinal to hook. Importing by ordinal is obsolete in Windows, and
+you shouldn't ever have to use it. The author of IATPatch was unable to test if
+ordinal hooking works correctly in IATPatch.
+
+=head2 METHODS
+
+=head3 Unpatch
+
+ die "failed to undo the patch error: $^E" if !
+ $IATPatch->Unpatch(); #undo the patch
+ #or
+ die "failed to undo the patch error: $^E" if !
+ $IATPatch->Unpatch(1); #undo the patch
+ #or
+ die "failed to undo the patch error: $^E" if !
+ $IATPatch->Unpatch(0); #never undo the patch
+ #or
+ die "failed to undo the patch error: $^E" if !
+ $IATPatch->Unpatch(undef); #never undo the patch
+
+Unpatches the DLL with the original destination function from the L<Win32::API::Callback::IATPatch/"new">
+call. Returns undef on failure with error number available through
+L<Win32::GetLastError|Win32/Win32::GetLastError()>/L<perlvar/"$^E">. If Unpatch was called once already,
+calling it again will fail, and error will be ERROR_NO_MORE_ITEMS.
+
+=head3 GetOriginalFunctionPtr
+
+Returns the original function pointer found in the import table in C<123456>
+format. If the returned pointer is 0, L<Win32::API::Callback::IATPatch/"Unpatch">
+was called earlier. There are no error numbers associated with this method.
+This value can be directly used to create a function pointer based Win32::API
+object to call the original destination function from inside your Perl callback.
+See L<Win32::API::Callback::IATPatch/"SYNOPSIS"> for a usage example.
+
+=head1 BUGS AND LIMITATIONS
+
+=over 4
+
+=item E<nbsp>Cygwin not supported
+
+L<new()|Win32::API::Callback::IATPatch/"new"> usually fatally errors on Cygwin
+with "IATPatch 3GB mode not supported" on Cygwins that allocate the heap at
+0x80000000 or are "Large Address Aware"
+
+=back
+
+=head1 SEE ALSO
+
+L<Win32::API::Callback>
+
+L<Win32::API>
+
+L<http://msdn.microsoft.com/en-us/magazine/cc301808.aspx>
+
+=head1 AUTHOR
+
+Daniel Dragan ( I<bulkdd@cpan.org> ).
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2012 by Daniel Dragan
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Struct.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Struct.pm
new file mode 100644
index 0000000000..85d1f7154d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Struct.pm
@@ -0,0 +1,755 @@
+#
+# Win32::API::Struct - Perl Win32 API struct Facility
+#
+# Author: Aldo Calpini <dada@perl.it>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+
+package Win32::API::Struct;
+use strict;
+use warnings;
+use vars qw( $VERSION );
+$VERSION = '0.67';
+
+my %Known = ();
+
+#import DEBUG sub
+sub DEBUG;
+*DEBUG = *Win32::API::DEBUG;
+
+#package main;
+#
+#sub userlazyapisub2{
+# userlazyapisub();
+#}
+#sub userlazyapisub {
+# Win32::API::Struct::lazyapisub();
+#}
+#
+#sub userapisub {
+# Win32::API::Struct::apisub();
+#}
+#
+#package Win32::API::Struct;
+#
+#sub lazyapisub {
+# lazycarp('bad');
+#}
+#sub apisub {
+# require Carp;
+# Carp::carp('bad');
+#}
+sub lazycarp {
+ require Carp;
+ Carp::carp(@_);
+}
+
+sub lazycroak {
+ require Carp;
+ Carp::croak(@_);
+}
+
+sub typedef {
+ my $class = shift;
+ my $struct = shift;
+ my ($type, $name, @recog_arr);
+ my $self = {
+ align => undef,
+ typedef => [],
+ };
+ while (defined($type = shift)) {
+ #not compatible with "unsigned foo;"
+ $type .= ' '.shift if $type eq 'unsigned' || $type eq 'signed';
+ $name = shift;
+ #"int foo [8];" instead of "int foo[8];" so tack on the array count
+ {
+ BEGIN{warnings->unimport('uninitialized')}
+ $name .= shift if substr($_[0],0,1) eq '[';
+ }
+ #typedef() takes a list, not a str, for backcompat, this can't be changed
+ #but, should typedef() keep shifting slices until it finds ";" or not?
+ #all the POD examples have ;s, but they are actually optional, should it
+ #be assumed that existing code was nice and used ;s or not? backcompat
+ #breaks if you say ;-less member defs should be allowed and aren't a user
+ #mistake
+ $name =~ s/;$//;
+ @recog_arr = recognize($type, $name);
+#http://perlmonks.org/?node_id=978468, not catching the type not found here,
+#will lead to a div 0 later
+ if(@recog_arr != 3){
+ lazycarp "Win32::API::Struct::typedef: unknown member type=\"$type\", name=\"$name\"";
+ return undef;
+ }
+ push(@{$self->{typedef}}, [@recog_arr]);
+ }
+
+ $Known{$struct} = $self;
+ $Win32::API::Type::Known{$struct} = '>';
+ return 1;
+}
+
+
+#void ck_type($param, $proto, $param_num)
+sub ck_type {
+ my ($param, $proto) = @_;
+ #legacy LP prefix check
+ return if substr($proto, 0, 2) eq 'LP' && substr($proto, 2) eq $param;
+ #check if proto can be converted to base struct name
+ return if exists $Win32::API::Struct::Pointer{$proto} &&
+ $param eq $Win32::API::Struct::Pointer{$proto};
+ #check if proto can have * chopped off to convert to base struct name
+ $proto =~ s/\s*\*$//;
+ return if $proto eq $param;
+ lazycroak("Win32::API::Call: supplied type (LP)\"".
+ $param."\"( *) doesn't match type \"".
+ $_[1]."\" for parameter ".
+ $_[2]." ");
+}
+
+#$basename = to_base_struct($pointername)
+sub to_base_struct {
+ return $Win32::API::Struct::Pointer{$_[0]}
+ if exists $Win32::API::Struct::Pointer{$_[0]};
+ die "Win32::API::Struct::Unpack unknown type";
+}
+
+sub recognize {
+ my ($type, $name) = @_;
+ my ($size, $packing);
+
+ if (exists $Known{$type}) {
+ $packing = '>';
+ return ($name, $packing, $type);
+ }
+ else {
+ $packing = Win32::API::Type::packing($type);
+ return undef unless defined $packing;
+ if ($name =~ s/\[(.*)\]$//) {
+ $size = $1;
+ $packing = $packing . '*' . $size;
+ }
+ DEBUG "(PM)Struct::recognize got '$name', '$type' -> '$packing'\n" if DEBUGCONST;
+ return ($name, $packing, $type);
+ }
+}
+
+sub new {
+ my $class = shift;
+ my ($type, $name, $packing);
+ my $self = {typedef => [],};
+ if ($#_ == 0) {
+ if (is_known($_[0])) {
+ DEBUG "(PM)Struct::new: got '$_[0]'\n" if DEBUGCONST;
+ if( ! defined ($self->{typedef} = $Known{$_[0]}->{typedef})){
+ lazycarp 'Win32::API::Struct::new: unknown type="'.$_[0].'"';
+ return undef;
+ }
+ foreach my $member (@{$self->{typedef}}) {
+ ($name, $packing, $type) = @$member;
+ next unless defined $name;
+ if ($packing eq '>') {
+ $self->{$name} = Win32::API::Struct->new($type);
+ }
+ }
+ $self->{__typedef__} = $_[0];
+ }
+ else {
+ lazycarp "Unknown Win32::API::Struct '$_[0]'";
+ return undef;
+ }
+ }
+ else {
+ while (defined($type = shift)) {
+ $name = shift;
+
+ # print "new: found member $name ($type)\n";
+ if (not exists $Win32::API::Type::Known{$type}) {
+ lazycarp "Unknown Win32::API::Struct type '$type'";
+ return undef;
+ }
+ else {
+ push(@{$self->{typedef}},
+ [$name, $Win32::API::Type::Known{$type}, $type]);
+ }
+ }
+ }
+ return bless $self;
+}
+
+sub members {
+ my $self = shift;
+ return map { $_->[0] } @{$self->{typedef}};
+}
+
+sub sizeof {
+ my $self = shift;
+ my $size = 0;
+ my $align = 0;
+ my $first = '';
+
+ for my $member (@{$self->{typedef}}) {
+ my ($name, $packing, $type) = @{$member};
+ next unless defined $name;
+ if (ref $self->{$name} eq q{Win32::API::Struct}) {
+
+ # If member is a struct, recursively calculate its size
+ # FIXME for subclasses
+ $size += $self->{$name}->sizeof();
+ }
+ else {
+
+ # Member is a simple type (LONG, DWORD, etc...)
+ if ($packing =~ /\w\*(\d+)/) { # Arrays (ex: 'c*260')
+ $size += Win32::API::Type::sizeof($type) * $1;
+ $first = Win32::API::Type::sizeof($type) * $1 unless defined $first;
+ DEBUG "(PM)Struct::sizeof: sizeof with member($name) now = " . $size
+ . "\n" if DEBUGCONST;
+ }
+ else { # Simple types
+ my $type_size = Win32::API::Type::sizeof($type);
+ $align = $type_size if $type_size > $align;
+ my $type_align = (($size + $type_size) % $type_size);
+ $size += $type_size + $type_align;
+ $first = Win32::API::Type::sizeof($type) unless defined $first;
+ }
+ }
+ }
+
+ my $struct_size = $size;
+ if (defined $align && $align > 0) {
+ $struct_size += ($size % $align);
+ }
+ DEBUG "(PM)Struct::sizeof first=$first totalsize=$struct_size\n" if DEBUGCONST;
+ return $struct_size;
+}
+
+sub align {
+ my $self = shift;
+ my $align = shift;
+
+ if (not defined $align) {
+
+ if (!(defined $self->{align} && $self->{align} eq 'auto')) {
+ return $self->{align};
+ }
+
+ $align = 0;
+
+ foreach my $member (@{$self->{typedef}}) {
+ my ($name, $packing, $type) = @$member;
+
+ if (ref($self->{$name}) eq "Win32::API::Struct") {
+ #### ????
+ }
+ else {
+ if ($packing =~ /\w\*(\d+)/) {
+ #### ????
+ }
+ else {
+ $align = Win32::API::Type::sizeof($type)
+ if Win32::API::Type::sizeof($type) > $align;
+ }
+ }
+ }
+ return $align;
+ }
+ else {
+ $self->{align} = $align;
+
+ }
+}
+
+sub getPack {
+ my $self = shift;
+ my $packing = "";
+ my $packed_size = 0;
+ my ($type, $name, $type_size, $type_align);
+ my @items = ();
+ my @recipients = ();
+ my @buffer_ptrs = (); #this contains the struct_ptrs that were placed in the
+ #the struct, its part of "C func changes the struct ptr to a private allocated
+ #struct" code, it is push/poped only for struct ptrs, it is NOT a 1 to
+ #1 mapping between all struct members, so don't access it with indexes
+
+ my $align = $self->align();
+
+ foreach my $member (@{$self->{typedef}}) {
+ my ($name, $type, $orig) = @$member;
+ if ($type eq '>') {
+ my ($subpacking, $subitems, $subrecipients, $subpacksize, $subbuffersptrs) =
+ $self->{$name}->getPack();
+ DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $subpacking\n" if DEBUGCONST;
+ push(@items, @$subitems);
+ push(@recipients, @$subrecipients);
+ push(@buffer_ptrs, @$subbuffersptrs);
+ $packing .= $subpacking;
+ $packed_size += $subpacksize;
+ }
+ else {
+ my $repeat = 1;
+ $type_size = Win32::API::Type::sizeof($orig);
+ if ($type =~ /\w\*(\d+)/) {
+ $repeat = $1;
+ $type = 'a'.($repeat*$type_size);
+ }
+
+ DEBUG "(PM)Struct::getPack($self->{__typedef__}) ++ $type\n" if DEBUGCONST;
+
+ if ($type eq 'p') {
+ $type = Win32::API::Type::pointer_pack_type();
+ push(@items, Win32::API::PointerTo($self->{$name}));
+ }
+ elsif ($type eq 'T') {
+ $type = Win32::API::Type::pointer_pack_type();
+ my $structptr;
+ if(ref($self->{$name})){
+ $self->{$name}->Pack();
+ $structptr = Win32::API::PointerTo($self->{$name}->{buffer});
+ }
+ else{
+ $structptr = 0;
+ }
+ push(@items, $structptr);
+ push(@buffer_ptrs, $structptr);
+ }
+ else {
+ push(@items, $self->{$name});
+ }
+ push(@recipients, $self);
+ $type_align = (($packed_size + $type_size) % $type_size);
+ $packing .= "x" x $type_align . $type;
+ $packed_size += ( $type_size * $repeat ) + $type_align;
+ }
+ }
+
+ DEBUG
+ "(PM)Struct::getPack: $self->{__typedef__}(buffer) = pack($packing, $packed_size)\n" if DEBUGCONST;
+
+ return ($packing, [@items], [@recipients], $packed_size, \@buffer_ptrs);
+}
+
+# void $struct->Pack([$priv_warnings_flag]);
+sub Pack {
+ my $self = shift;
+ my ($packing, $items);
+ ($packing, $items, $self->{buffer_recipients},
+ undef, $self->{buffer_ptrs}) = $self->getPack();
+
+ DEBUG "(PM)Struct::Pack: $self->{__typedef__}(buffer) = pack($packing, @$items)\n" if DEBUGCONST;
+
+ if($_[0]){ #Pack() on a new struct, without slice set, will cause lots of uninit
+ #warnings, sometimes its intentional to set up buffer recipients for a
+ #future UnPack()
+ BEGIN{warnings->unimport('uninitialized')}
+ $self->{buffer} = pack($packing, @$items);
+ }
+ else{
+ $self->{buffer} = pack($packing, @$items);
+ }
+ if (DEBUGCONST) {
+ for my $i (0 .. $self->sizeof - 1) {
+ printf "#pack# %3d: 0x%02x\n", $i, ord(substr($self->{buffer}, $i, 1));
+ }
+ }
+}
+
+sub getUnpack {
+ my $self = shift;
+ my $packing = "";
+ my $packed_size = 0;
+ my ($type, $name, $type_size, $type_align, $orig_type);
+ my (@items, @types, @type_names);
+ my $align = $self->align();
+ foreach my $member (@{$self->{typedef}}) {
+ my ($name, $type, $orig) = @$member;
+ if ($type eq '>') {
+ my ($subpacking, $subpacksize, $subitems, $subtypes, $subtype_names) = $self->{$name}->getUnpack();
+ DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $subpacking\n" if DEBUGCONST;
+ $packing .= $subpacking;
+ $packed_size += $subpacksize;
+ push(@items, @$subitems);
+ push(@types, @$subtypes);
+ push(@type_names, @$subtype_names);
+ }
+ else {
+ if($type eq 'T') {
+ $orig_type = $type;
+ $type = Win32::API::Type::pointer_pack_type();
+ }
+ $type_size = Win32::API::Type::sizeof($orig);
+ my $repeat = 1;
+ if ($type =~ /\w\*(\d+)/) { #some kind of array
+ $repeat = $1;
+ $type =
+ $type_size == 1 ?
+ 'Z'.$repeat #have pack truncate to NULL char
+ :'a'.($repeat*$type_size); #manually truncate to wide NULL char later
+ }
+ DEBUG "(PM)Struct::getUnpack($self->{__typedef__}) ++ $type\n" if DEBUGCONST;
+ $type_align = (($packed_size + $type_size) % $type_size);
+ $packing .= "x" x $type_align . $type;
+ $packed_size += ( $type_size * $repeat ) + $type_align;
+ push(@items, $name);
+ if($orig_type){
+ push(@types, $orig_type);
+ undef($orig_type);
+ }
+ else{
+ push(@types, $type);
+ }
+ push(@type_names, $orig);
+ }
+ }
+ DEBUG "(PM)Struct::getUnpack($self->{__typedef__}): unpack($packing, @items)\n" if DEBUGCONST;
+ return ($packing, $packed_size, \@items, \@types, \@type_names);
+}
+
+sub Unpack {
+ my $self = shift;
+ my ($packing, undef, $items, $types, $type_names) = $self->getUnpack();
+ my @itemvalue = unpack($packing, $self->{buffer});
+ DEBUG "(PM)Struct::Unpack: unpack($packing, buffer) = @itemvalue\n" if DEBUGCONST;
+ foreach my $i (0 .. $#$items) {
+ my $recipient = $self->{buffer_recipients}->[$i];
+ my $item = $$items[$i];
+ my $type = $$types[$i];
+ DEBUG "(PM)Struct::Unpack: %s(%s) = '%s' (0x%08x)\n",
+ $recipient->{__typedef__},
+ $item,
+ $itemvalue[$i],
+ $itemvalue[$i],
+ if DEBUGCONST;
+ if($type eq 'T'){
+my $oldstructptr = pop(@{$self->{buffer_ptrs}});
+my $newstructptr = $itemvalue[$i];
+my $SVMemberRef = \$recipient->{$item};
+
+if(!$newstructptr){ #new ptr is null
+ if($oldstructptr != $newstructptr){ #old ptr was true
+ lazycarp "Win32::API::Struct::Unpack struct pointer".
+ " member \"".$item."\" was changed by C function,".
+ " possible resource leak";
+ }
+ $$SVMemberRef = undef;
+}
+else{ #new ptr is true
+ if($oldstructptr != $newstructptr){#old ptr was true, or null, but has changed, leak warning
+ lazycarp "Win32::API::Struct::Unpack struct pointer".
+ " member \"".$item."\" was changed by C function,".
+ " possible resource leak";
+ }#create a ::Struct if the slice is undef, user had the slice set to undef
+
+ if (!ref($$SVMemberRef)){
+ $$SVMemberRef = Win32::API::Struct->new(to_base_struct($type_names->[$i]));
+ $$SVMemberRef->Pack(1); #buffer_recipients must be generated, no uninit warnings
+ }
+#must fix {buffer} with contents of the new struct, $structptr might be
+#null or might be a SVPV from a ::Struct that was ignored, in any case,
+#a foreign memory allocator is at work here
+ $$SVMemberRef->{buffer} = Win32::API::ReadMemory($newstructptr, $$SVMemberRef->sizeof)
+ if($oldstructptr != $newstructptr);
+#always must be called, if new ptr is not null, at this point, C func, did
+#one of 2 things, filled the old ::Struct's {buffer} PV, or gave a new struct *
+#from its own allocator, there is no way to tell if the struct contents changed
+#so Unpack() must be called
+ $$SVMemberRef->Unpack();
+}
+}
+ else{ #not a struct ptr
+ my $itemvalueref = \$itemvalue[$i];
+ Win32::API::_TruncateToWideNull($$itemvalueref)
+ if substr($type,0,1) eq 'a' && length($type) > 1;
+ $recipient->{$item} = $$itemvalueref;
+
+ # DEBUG "(PM)Struct::Unpack: self.items[$i] = $self->{$$items[$i]}\n";
+ }
+ }
+}
+
+sub FromMemory {
+ my ($self, $addr) = @_;
+ DEBUG "(PM)Struct::FromMemory: doing Pack\n" if DEBUGCONST;
+ $self->Pack();
+ DEBUG "(PM)Struct::FromMemory: doing GetMemory( 0x%08x, %d )\n", $addr, $self->sizeof if DEBUGCONST;
+ $self->{buffer} = Win32::API::ReadMemory($addr, $self->sizeof);
+ $self->Unpack();
+ if(DEBUGCONST) {
+ DEBUG "(PM)Struct::FromMemory: doing Unpack\n";
+ DEBUG "(PM)Struct::FromMemory: structure is now:\n";
+ $self->Dump();
+ DEBUG "\n";
+ }
+}
+
+sub Dump {
+ my $self = shift;
+ my $prefix = shift;
+ foreach my $member (@{$self->{typedef}}) {
+ my ($name, $packing, $type) = @$member;
+ if (ref($self->{$name})) {
+ $self->{$name}->Dump($name);
+ }
+ else {
+ printf "%-20s %-20s %-20s\n", $prefix, $name, $self->{$name};
+ }
+ }
+}
+
+#the LP logic should be moved to parse_prototype, since only
+#::API::Call() ever understood the implied LP prefix, Struct::new never did
+#is_known then can be inlined away and sub deleted, it is not public API
+sub is_known {
+ my $name = shift;
+ if (exists $Known{$name}) {
+ return 1;
+ }
+ else {
+ my $nametest = $name;
+ if ($nametest =~ s/^LP//) {
+ return exists $Known{$nametest};
+ }
+ $nametest = $name;
+ if($nametest =~ s/\*$//){
+ return exists $Known{$nametest};
+ }
+ return 0;
+ }
+}
+
+sub TIEHASH {
+ return Win32::API::Struct::new(@_);
+}
+
+sub EXISTS {
+
+}
+
+sub FETCH {
+ my $self = shift;
+ my $key = shift;
+
+ if ($key eq 'sizeof') {
+ return $self->sizeof;
+ }
+ my @members = map { $_->[0] } @{$self->{typedef}};
+ if (grep(/^\Q$key\E$/, @members)) {
+ return $self->{$key};
+ }
+ else {
+ warn "'$key' is not a member of Win32::API::Struct $self->{__typedef__}";
+ }
+}
+
+sub STORE {
+ my $self = shift;
+ my ($key, $val) = @_;
+ my @members = map { $_->[0] } @{$self->{typedef}};
+ if (grep(/^\Q$key\E$/, @members)) {
+ $self->{$key} = $val;
+ }
+ else {
+ warn "'$key' is not a member of Win32::API::Struct $self->{__typedef__}";
+ }
+}
+
+sub FIRSTKEY {
+ my $self = shift;
+ my @members = map { $_->[0] } @{$self->{typedef}};
+ return $members[0];
+}
+
+sub NEXTKEY {
+ my $self = shift;
+ my $key = shift;
+ my @members = map { $_->[0] } @{$self->{typedef}};
+ for my $i (0 .. $#members - 1) {
+ return $members[$i + 1] if $members[$i] eq $key;
+ }
+ return undef;
+}
+
+1;
+
+__END__
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API::Struct - C struct support package for Win32::API
+
+=head1 SYNOPSIS
+
+ use Win32::API;
+
+ Win32::API::Struct->typedef( 'POINT', qw(
+ LONG x;
+ LONG y;
+ ));
+
+ my $Point = Win32::API::Struct->new( 'POINT' );
+ $Point->{x} = 1024;
+ $Point->{y} = 768;
+
+ #### alternatively
+
+ tie %Point, 'Win32::API::Struct', 'POINT';
+ $Point{x} = 1024;
+ $Point{y} = 768;
+
+
+=head1 ABSTRACT
+
+This module enables you to define C structs for use with
+Win32::API.
+
+See L<Win32::API/USING STRUCTURES> for more info about its usage.
+
+=head1 DESCRIPTION
+
+This module is automatically imported by Win32::API, so you don't
+need to 'use' it explicitly. The main methods are C<typedef> and
+C<new>, which are documented below.
+
+=over 4
+
+=item C<typedef NAME, TYPE, MEMBER, TYPE, MEMBER, ...>
+
+This method defines a structure named C<NAME>. The definition consists
+of types and member names, just like in C. In fact, most of the
+times you can cut the C definition for a structure and paste it
+verbatim to your script, enclosing it in a C<qw()> block. The
+function takes care of removing the semicolon after the member
+name. Win32::API::Struct does B<NOT> support Enums, Unions, or Bitfields.
+C<NAME> must not end in C<*>, typedef creates structs, not struct pointers.
+See L<Win32::API::Type/"typedef">
+on how to create a struct pointer type. Returns true on success, and undef on error.
+On error it L<warns|perlfunc/warn> with the specific reason.
+
+The synopsis example could be written like this:
+
+ Win32::API::Struct->typedef('POINT', 'LONG', 'x', 'LONG', 'y');
+
+But it could also be written like this (note the indirect object
+syntax), which is pretty cool:
+
+ typedef Win32::API::Struct POINT => qw{
+ LONG x;
+ LONG y;
+ };
+
+L<Win32::API/Call> automatically knows that an 'LPNAME' type, refers
+to a 'NAME' type struct. Also see L<Win32::API::Type/"typedef"> on how to declare
+pointers to struct types.
+
+Unlike in Win32::API, a single non-array char or CHAR struct member in a
+struct is numeric, NOT the first character of a string. UTF16 strings pointers
+will be garbage on read back (passing in works, returning doesn't) since
+the NULL character will often be the 2nd byte of the UTF16 string.
+
+=item C<new NAME>
+
+This creates a structure (a Win32::API::Struct object) of the
+type C<NAME> (it must have been defined with C<typedef>). In Perl,
+when you create a structure, all the members are undefined. But
+when you use that structure in C (eg. a Win32::API call), you
+can safely assume that they will be treated as zero (or NULL).
+
+=item C<sizeof>
+
+This returns the size, in bytes, of the structure. Acts just like
+the C function of the same name. It is particularly useful for
+structures that need a member to be initialized to the structure's
+own size.
+
+=item C<align [SIZE]>
+
+Sets or returns the structure alignment (eg. how the structure is
+stored in memory). This is a very advanced option, and you normally
+don't need to mess with it.
+All structures in the Win32 Platform SDK should work without it.
+But if you define your own structure, you may need to give it an
+explicit alignment. In most cases, passing a C<SIZE> of 'auto'
+should keep the world happy.
+
+=back
+
+=head2 THE C<tie> INTERFACE
+
+Instead of creating an object with the C<new> method, you can
+tie a hash, which will hold the desired structure, using the
+C<tie> builtin function:
+
+ tie %structure, Win32::API::Struct => 'NAME';
+
+The differences between the tied and non-tied approaches are:
+
+=over 4
+
+=item *
+with tied structures, you can access members directly as
+hash lookups, eg.
+
+ # tied # non-tied
+ $Point{x} vs. $Point->{x}
+
+=item *
+with tied structures, when you try to fetch or store a
+member that is not part of the structure, it will result
+in a warning, eg.
+
+ print $Point{z};
+ # this will warn: 'z' is not a member of Win32::API::Struct POINT
+
+=item *
+when you pass a tied structure as a Win32::API parameter,
+remember to backslash it, eg.
+
+ # tied # non-tied
+ GetCursorPos( \%Point ) vs. GetCursorPos( $Point )
+
+=back
+
+=head2 FOREIGN MEMORY ALLOCATORS
+
+Using Win32::API::Struct is not recommended in situations where a C function
+will return results to you by putting a pointer to a string or a pointer to
+another struct into your supplied struct. Win32::API::Struct will do its best
+to detect that a new pointer appeared and to read it contents into Perl, but
+that pointer will be tossed away after being read. If this pointer is
+something you must explicitly free, you have leaked it by using
+Win32::API::Struct to decode it. If this pointer is something you must pass back to
+the C API you are using, you lost/leaked it. If you pass NULL, or a ::Struct
+pointer in a ::Struct to C API, after the C API call, ::Struct will detect the
+pointer changed, it will read the new struct from the new pointer into
+Perl, and a new child ::Struct will appear in the hash slice
+of the parent ::Struct, if you pass this new child ::Struct into the C API
+it will be a B<COPY> of the struct the C API from Perl's allocation placed
+in the parent ::Struct. For C++-like APIs, this will be unacceptable and lead to
+crashes as the C Functions tries to free a memory block that didn't come from the
+allocator of the C Function. Windows has many memory allocators, each CRT
+(VS 2, 3, 4, 5, NT/6, 7.0, 7.1, 8, 9, 10) malloc, LocalAlloc, GlobalAlloc,
+HeapAlloc, (each version of C++ Runtime Library) "new", CoGetMalloc, CoTaskMemAlloc,
+NetApiBufferAllocate, VirtualAlloc, CryptMemAlloc, AllocADsMem, SHAlloc,
+SnmpUtilMemAlloc. None of these allocators' pointers are compatible with Perl's
+allocator. Some C APIs give you static global buffers which never are freed or freed
+automatically in the next call to a function from to that DLL.
+
+With foreign allocators, its best to treat to write a pointer class, bless the
+ref to scalar integer (holding the pointer) into that class to ensure that the
+DESTROY method will free the pointer and you never leak it, and your write
+method accessors using L<perlfunc/pack>, L<Win32::API/ReadMemory> and
+L<Win32::API/WriteMemory> around the pointer.
+
+
+=head1 AUTHOR
+
+Aldo Calpini ( I<dada@perl.it> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> ).
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Type.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Type.pm
new file mode 100644
index 0000000000..3c4c4d5fea
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/API/Type.pm
@@ -0,0 +1,590 @@
+package Win32::API::Type;
+
+# See the bottom of this file for the POD documentation. Search for the
+# string '=head'.
+
+#######################################################################
+#
+# Win32::API::Type - Perl Win32 API type definitions
+#
+# Author: Aldo Calpini <dada@perl.it>
+# Maintainer: Cosimo Streppone <cosimo@cpan.org>
+#
+#######################################################################
+
+use strict;
+use warnings;
+use vars qw( %Known %PackSize %Modifier %Pointer $VERSION );
+
+$VERSION = '0.70';
+
+#import DEBUG sub
+sub DEBUG;
+*DEBUG = *Win32::API::DEBUG;
+
+#const optimize
+BEGIN {
+ eval ' sub pointer_pack_type () { \''
+ .(PTRSIZE == 8 ? 'Q' : 'L').
+ '\' }';
+}
+
+%Known = ();
+%PackSize = ();
+%Modifier = ();
+%Pointer = ();
+
+# Initialize data structures at startup.
+# Aldo wants to keep the <DATA> approach.
+#
+my $section = 'nothing';
+foreach (<DATA>) {
+ next if /^\s*(?:#|$)/;
+ chomp;
+ if (/\[(.+)\]/) {
+ $section = $1;
+ next;
+ }
+ if ($section eq 'TYPE') {
+ my ($name, $packing) = split(/\s+/);
+
+ # DEBUG "(PM)Type::INIT: Known('$name') => '$packing'\n";
+ $packing = pointer_pack_type()
+ if ($packing eq '_P');
+ $Known{$name} = $packing;
+ }
+ elsif ($section eq 'POINTER') {
+ my ($pointer, $pointto) = split(/\s+/);
+
+ # DEBUG "(PM)Type::INIT: Pointer('$pointer') => '$pointto'\n";
+ $Pointer{$pointer} = $pointto;
+ }
+ elsif ($section eq 'PACKSIZE') {
+ my ($packing, $size) = split(/\s+/);
+
+ # DEBUG "(PM)Type::INIT: PackSize('$packing') => '$size'\n";
+ $size = PTRSIZE
+ if ($size eq '_P');
+ $PackSize{$packing} = $size;
+ }
+ elsif ($section eq 'MODIFIER') {
+ my ($modifier, $mapto) = split(/\s+/, $_, 2);
+ my %maps = ();
+ foreach my $item (split(/\s+/, $mapto)) {
+ my ($k, $v) = split(/=/, $item);
+ $maps{$k} = $v;
+ }
+
+ # DEBUG "(PM)Type::INIT: Modifier('$modifier') => '%maps'\n";
+ $Modifier{$modifier} = {%maps};
+ }
+}
+close(DATA);
+
+sub new {
+ my $class = shift;
+ my ($type) = @_;
+ my $packing = packing($type);
+ my $size = sizeof($type);
+ my $self = {
+ type => $type,
+ packing => $packing,
+ size => $size,
+ };
+ return bless $self;
+}
+
+sub typedef {
+ my $class = shift;
+ my ($name, $type) = @_;
+ $type =~ m/^\s*(.*?)\s*$/;
+ $type =~ m/^(.+?)\s*(\*)$/;
+ $type = $1;
+ $type .= $2 if defined $2;
+ $name =~ m/^\s*(.*?)\s*$/;
+ $name =~ m/^(.+?)\s*(\*)$/;
+ $name = $1;
+ $name .= $2 if defined $2;
+ #FIXME BUG, unsigned __int64 * doesn't pase in typedef, it does in parse_prototype
+ my $packing = packing($type, $name); #FIXME BUG
+ if(! defined $packing){
+ warn "Win32::API::Type::typedef: WARNING unknown type '$_[1]'";
+ return undef;
+ }
+ #Win32::API::Struct logic
+ #limitation, this won't alias a new struct type to an existing struct type
+ #this only creates new struct type pointer types to an existing struct type
+ if($packing eq '>'){
+ if(is_pointer($type)){
+ $packing = 'T';
+ $type =~ s/\s*\*$//; #chop off ' *'
+ $Win32::API::Struct::Pointer{$name} = $type;
+ }
+ else{
+ warn "Win32::API::Type::typedef: aliasing struct \"".$_[0]
+ ."\" to struct \"".$_[1]."\" not supported";
+ return undef;
+ }
+ }
+ DEBUG "(PM)Type::typedef: packing='$packing'\n" if DEBUGCONST;
+ if($packing eq 'p'){
+ $Pointer{$name} = $Pointer{$type};
+ }else{
+ $Known{$name} = $packing;
+ }
+ return 1;
+}
+
+
+sub is_known {
+ my $self = shift;
+ my $type = shift;
+ $type = $self unless defined $type;
+ if (ref($type) =~ /Win32::API::Type/) {
+ return 1;
+ }
+ else {
+ return defined packing($type);
+ }
+}
+
+sub sizeof {
+ my $self = shift;
+ my $type = shift;
+ $type = $self unless defined $type;
+ if (ref($type) =~ /Win32::API::Type/) {
+ return $self->{size};
+ }
+ else {
+ my $packing = packing($type);
+ if ($packing =~ /(\w)\*(\d+)/) {
+ return $PackSize{$1} * $2;
+ }
+ else {
+ return $PackSize{$packing};
+ }
+ }
+}
+# $packing_letter = packing( [$class = 'Win32::API::Type' ,] $type [, $pass_numeric])
+sub packing {
+
+ # DEBUG "(PM)Type::packing: called by ". join("::", (caller(1))[0,3]). "\n";
+ my $self = shift;
+ my $is_pointer = 0;
+ if (ref($self) =~ /Win32::API::Type/) {
+
+ # DEBUG "(PM)Type::packing: got an object\n";
+ return $self->{packing};
+ }
+ my $type = ($self eq 'Win32::API::Type') ? shift : $self;
+ my $name = shift;
+ my $pass_numeric = shift;
+
+ # DEBUG "(PM)Type::packing: got '$type', '$name'\n";
+ my ($modifier, $size, $packing);
+ if (exists $Pointer{$type}) {
+
+ # DEBUG "(PM)Type::packing: got '$type', is really '$Pointer{$type}'\n";
+ $type = $Pointer{$type};
+ $is_pointer = 1;
+ }
+ elsif ($type =~ /(\w+)\s+(\w+)/) {
+ $modifier = $1;
+ $type = $2;
+
+ # DEBUG "(PM)packing: got modifier '$modifier', type '$type'\n";
+ }
+
+ $type =~ s/\s*\*$//; #kill whitespace "CHAR " isn't "CHAR"
+
+ if (exists $Known{$type}) {
+ if (defined $name and $name =~ s/\[(.*)\]$//) {
+ $size = $1;
+ $packing = $Known{$type}[0] . "*" . $size;
+
+ # DEBUG "(PM)Type::packing: composite packing: '$packing' '$size'\n";
+ }
+ else {
+ $packing = $Known{$type};
+ if ($is_pointer and ($packing eq 'c' or $packing eq 'S')) {
+ $packing = "p";
+ }
+
+ # DEBUG "(PM)Type::packing: simple packing: '$packing'\n";
+ }
+ if (defined $modifier and exists $Modifier{$modifier}->{$type}) {
+
+# DEBUG "(PM)Type::packing: applying modifier '$modifier' -> '$Modifier{$modifier}->{$type}'\n";
+ $packing = $Modifier{$modifier}->{$type};
+ if(!$pass_numeric) { #for older num unaware calls
+ substr($packing, 0, length("num"), '');
+ }
+ }
+ return $packing;
+ }
+ else {
+
+ # DEBUG "(PM)Type::packing: NOT FOUND\n";
+ return undef;
+ }
+}
+
+
+sub is_pointer {
+ my $self = shift;
+ my $type = shift;
+ $type = $self unless defined $type;
+ if (ref($type) =~ /Win32::API::Type/) {
+ return 1;
+ }
+ else {
+ if ($type =~ /\*$/) {
+ return 1;
+ }
+ else {
+ return exists $Pointer{$type};
+ }
+ }
+}
+
+sub Pack {
+ my $type = $_[1];
+
+ my $pack_type = packing($type);
+ #print "Pack: type $type pack_type $pack_type\n";
+ if ($pack_type eq 'p') { #char or wide char pointer
+ #$pack_type = 'Z*';
+ return;
+ }
+ elsif(IVSIZE() == 4 && ($pack_type eq 'q' || $pack_type eq 'Q')){
+ if($_[0]->UseMI64() || ref($_[2])){ #un/signed meaningless
+ $_[2] = Math::Int64::int64_to_native($_[2]);
+ }
+ else{
+ if(length($_[2]) < 8){
+ warn("Win32::API::Call value for 64 bit integer is under 8 bytes long");
+ $_[2] = pack('a8', $_[2]);
+ }
+ }
+ return;
+ }
+ $_[2] = pack($pack_type, $_[2]);
+ return;
+}
+
+sub Unpack {
+ my $type = $_[1];
+
+ my $pack_type = packing($type);
+
+ if ($pack_type eq 'p') {
+ DEBUG "(PM)Type::Unpack: got packing 'p': is a pointer\n" if DEBUGCONST;
+ #$pack_type = 'Z*';
+ return;
+ }
+ elsif(IVSIZE() == 4){
+ #todo debugging output
+ if($pack_type eq 'q'){
+ if($_[0]->UseMI64() || ref($_[2])){
+ $_[2] = Math::Int64::native_to_int64($_[2]);
+ DEBUG "(PM)Type::Unpack: returning signed Math::Int64 '".$_[2]."'\n" if DEBUGCONST;
+ }
+ return;
+ }elsif($pack_type eq 'Q'){
+ if($_[0]->UseMI64() || ref($_[2])){
+ $_[2] = Math::Int64::native_to_uint64($_[2]);
+ DEBUG "(PM)Type::Unpack: returning unsigned Math::Int64 '".$_[2]."'\n" if DEBUGCONST;
+ }
+ return;
+ }
+ }
+ DEBUG "(PM)Type::Unpack: unpacking '$pack_type' '$_[2]'\n" if DEBUGCONST;
+ $_[2] = unpack($pack_type, $_[2]);
+ DEBUG "(PM)Type::Unpack: returning '" . ($_[2] || '') . "'\n" if DEBUGCONST;
+}
+
+1;
+
+#######################################################################
+# DOCUMENTATION
+#
+
+=head1 NAME
+
+Win32::API::Type - C type support package for Win32::API
+
+=head1 SYNOPSIS
+
+ use Win32::API;
+
+ Win32::API::Type->typedef( 'my_number', 'LONG' );
+
+
+=head1 ABSTRACT
+
+This module is a support package for Win32::API that implements
+C types for the import with prototype functionality.
+
+See L<Win32::API> for more info about its usage.
+
+=head1 DESCRIPTION
+
+This module is automatically imported by Win32::API, so you don't
+need to 'use' it explicitly. These are the methods of this package:
+
+=over 4
+
+=item C<typedef NAME, TYPE>
+
+This method defines a new type named C<NAME>. This actually just
+creates an alias for the already-defined type C<TYPE>, which you
+can use as a parameter in a Win32::API call.
+
+When C<TYPE> contains a Win32::API::Struct type declared with
+L<Win32::API::Struct/typedef> with " *" postfixed to C<TYPE> parameter,
+C<NAME> will be a alias for the pointer version of the struct type. Creating
+an alias for a struct type is not supported, you have to call
+L<Win32::API::Struct/typedef> again. Passing a struct type as C<TYPE>
+without the " *" postfix is not supported.
+
+L<Warns|perlfunc/warn> and returns undef if C<TYPE> is unknown, else returns true.
+
+=item C<sizeof TYPE>
+
+This returns the size, in bytes, of C<TYPE>. Acts just like
+the C function of the same name.
+
+=item C<is_known TYPE>
+
+Returns true if C<TYPE> is known by Win32::API::Type, false
+otherwise.
+
+=back
+
+=head2 SUPPORTED TYPES
+
+This module recognizes many commonly used types defined in the Win32 Platform
+SDK header files, but not all. Types less than 13 years old are very unlikely
+to be the in built type database.
+
+Please see the source for this module, in the C<__DATA__> section,
+for the full list of builtin supported types.
+
+
+=head2 NOTES ON SELECT TYPES
+
+=over 4
+
+=item LPVOID
+
+Due to poor design, currently LPVOID is a char *, a string, not a number.
+It should really be a number. It is suggested to replace LPVOID in your
+C prototypes passed to Win32::API with UINT_PTR which is a pointer
+sized number.
+
+=item SOMETYPE **
+
+Currently ** types do not parse.
+
+=item void **
+
+Replace void ** in your C prototype that you pass to Win32::API::More with
+LPHANDLE.
+
+=item unsigned char
+
+=item signed char
+
+These 2 types by name force numeric handling. C<97> not C<"a">. C<UCHAR> is
+not a C<unsigned char> for numeric handling purposes.
+
+=back
+
+=head1 AUTHOR
+
+Aldo Calpini ( I<dada@perl.it> ).
+
+=head1 MAINTAINER
+
+Cosimo Streppone ( I<cosimo@cpan.org> ).
+
+=cut
+
+
+__DATA__
+
+[TYPE]
+ATOM s
+BOOL L
+BOOLEAN c
+BYTE C
+CHAR c
+COLORREF L
+DWORD L
+DWORD32 L
+DWORD64 Q
+DWORD_PTR _P
+FLOAT f
+HACCEL _P
+HANDLE _P
+HBITMAP _P
+HBRUSH _P
+HCOLORSPACE _P
+HCONV _P
+HCONVLIST _P
+HCURSOR _P
+HDC _P
+HDDEDATA _P
+HDESK _P
+HDROP _P
+HDWP _P
+HENHMETAFILE _P
+HFILE _P
+HFONT _P
+HGDIOBJ _P
+HGLOBAL _P
+HHOOK _P
+HICON _P
+HIMC _P
+HINSTANCE _P
+HKEY _P
+HKL _P
+HLOCAL _P
+HMENU _P
+HMETAFILE _P
+HMODULE _P
+HPALETTE _P
+HPEN _P
+HRGN _P
+HRSRC _P
+HSZ _P
+HWINSTA _P
+HWND _P
+INT i
+INT32 i
+INT64 q
+LANGID s
+LCID L
+LCSCSTYPE L
+LCSGAMUTMATCH L
+LCTYPE L
+LONG l
+LONG32 l
+LONG64 q
+LONGLONG q
+LPARAM _P
+LRESULT _P
+NTSTATUS l
+REGSAM L
+SC_HANDLE _P
+SC_LOCK _P
+SERVICE_STATUS_HANDLE _P
+SHORT s
+SIZE_T _P
+SSIZE_T _P
+TBYTE c
+TCHAR C
+UCHAR C
+UINT I
+UINT_PTR _P
+UINT32 I
+UINT64 Q
+ULONG L
+ULONG32 L
+ULONG64 Q
+ULONGLONG Q
+USHORT S
+WCHAR S
+WORD S
+WPARAM _P
+VOID c
+
+int i
+long l
+float f
+double d
+char c
+short s
+void c
+__int64 q
+
+#VOID is a 'c'? huh?
+#making void be a 'c' too, ~bulk88
+#CRITICAL_SECTION 24 -- a structure
+#LUID ? 8 -- a structure
+#VOID 0
+#CONST 4
+#FILE_SEGMENT_ELEMENT 8 -- a structure
+
+[PACKSIZE]
+c 1
+C 1
+d 8
+f 4
+i 4
+I 4
+l 4
+L 4
+q 8
+Q 8
+s 2
+S 2
+p _P
+T _P
+t _P
+
+[MODIFIER]
+unsigned int=numI long=numL short=numS char=numC
+signed int=numi long=numl short=nums char=numc
+
+[POINTER]
+INT_PTR INT
+LPBOOL BOOL
+LPBYTE BYTE
+LPCOLORREF COLORREF
+LPCSTR CHAR
+#LPCTSTR CHAR or WCHAR
+LPCTSTR CHAR
+LPCVOID any
+LPCWSTR WCHAR
+LPDOUBLE double
+LPDWORD DWORD
+LPHANDLE HANDLE
+LPINT INT
+LPLONG LONG
+LPSTR CHAR
+#LPTSTR CHAR or WCHAR
+LPTSTR CHAR
+LPVOID VOID
+LPWORD WORD
+LPWSTR WCHAR
+
+PBOOL BOOL
+PBOOLEAN BOOL
+PBYTE BYTE
+PCHAR CHAR
+PCSTR CSTR
+PCWCH CWCH
+PCWSTR CWSTR
+PDWORD DWORD
+PFLOAT FLOAT
+PHANDLE HANDLE
+PHKEY HKEY
+PINT INT
+PLCID LCID
+PLONG LONG
+PSHORT SHORT
+PSTR CHAR
+#PTBYTE TBYTE --
+#PTCHAR TCHAR --
+#PTSTR CHAR or WCHAR
+PTSTR CHAR
+PUCHAR UCHAR
+PUINT UINT
+PULONG ULONG
+PUSHORT USHORT
+PVOID VOID
+PWCHAR WCHAR
+PWORD WORD
+PWSTR WCHAR
+char* CHAR
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/Console.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/Console.pm
new file mode 100644
index 0000000000..2e41c2a83d
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/Console.pm
@@ -0,0 +1,1463 @@
+#######################################################################
+#
+# Win32::Console - Win32 Console and Character Mode Functions
+#
+#######################################################################
+
+package Win32::Console;
+
+require Exporter;
+require DynaLoader;
+
+$VERSION = "0.10";
+
+@ISA= qw( Exporter DynaLoader );
+@EXPORT = qw(
+ BACKGROUND_BLUE
+ BACKGROUND_GREEN
+ BACKGROUND_INTENSITY
+ BACKGROUND_RED
+ CAPSLOCK_ON
+ CONSOLE_TEXTMODE_BUFFER
+ CTRL_BREAK_EVENT
+ CTRL_C_EVENT
+ ENABLE_ECHO_INPUT
+ ENABLE_LINE_INPUT
+ ENABLE_MOUSE_INPUT
+ ENABLE_PROCESSED_INPUT
+ ENABLE_PROCESSED_OUTPUT
+ ENABLE_WINDOW_INPUT
+ ENABLE_WRAP_AT_EOL_OUTPUT
+ ENHANCED_KEY
+ FILE_SHARE_READ
+ FILE_SHARE_WRITE
+ FOREGROUND_BLUE
+ FOREGROUND_GREEN
+ FOREGROUND_INTENSITY
+ FOREGROUND_RED
+ LEFT_ALT_PRESSED
+ LEFT_CTRL_PRESSED
+ NUMLOCK_ON
+ GENERIC_READ
+ GENERIC_WRITE
+ RIGHT_ALT_PRESSED
+ RIGHT_CTRL_PRESSED
+ SCROLLLOCK_ON
+ SHIFT_PRESSED
+ STD_INPUT_HANDLE
+ STD_OUTPUT_HANDLE
+ STD_ERROR_HANDLE
+ $FG_BLACK
+ $FG_GRAY
+ $FG_BLUE
+ $FG_LIGHTBLUE
+ $FG_RED
+ $FG_LIGHTRED
+ $FG_GREEN
+ $FG_LIGHTGREEN
+ $FG_MAGENTA
+ $FG_LIGHTMAGENTA
+ $FG_CYAN
+ $FG_LIGHTCYAN
+ $FG_BROWN
+ $FG_YELLOW
+ $FG_LIGHTGRAY
+ $FG_WHITE
+ $BG_BLACK
+ $BG_GRAY
+ $BG_BLUE
+ $BG_LIGHTBLUE
+ $BG_RED
+ $BG_LIGHTRED
+ $BG_GREEN
+ $BG_LIGHTGREEN
+ $BG_MAGENTA
+ $BG_LIGHTMAGENTA
+ $BG_CYAN
+ $BG_LIGHTCYAN
+ $BG_BROWN
+ $BG_YELLOW
+ $BG_LIGHTGRAY
+ $BG_WHITE
+ $ATTR_NORMAL
+ $ATTR_INVERSE
+ @CONSOLE_COLORS
+);
+
+
+#######################################################################
+# This AUTOLOAD is used to 'autoload' constants from the constant()
+# XS function. If a constant is not found then control is passed
+# to the AUTOLOAD in AutoLoader.
+#
+
+sub AUTOLOAD {
+ my($constname);
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ #reset $! to zero to reset any current errors.
+ local $! = 0;
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($! != 0) {
+# if ($! =~ /Invalid/) {
+# $AutoLoader::AUTOLOAD = $AUTOLOAD;
+# goto &AutoLoader::AUTOLOAD;
+# } else {
+ ($pack, $file, $line) = caller; undef $pack;
+ die "Symbol Win32::Console::$constname not defined, used at $file line $line.";
+# }
+ }
+ eval "sub $AUTOLOAD { $val }";
+ goto &$AUTOLOAD;
+}
+
+
+#######################################################################
+# STATIC OBJECT PROPERTIES
+#
+
+# %HandlerRoutineStack = ();
+# $HandlerRoutineRegistered = 0;
+
+#######################################################################
+# PUBLIC METHODS
+#
+
+#========
+sub new {
+#========
+ my($class, $param1, $param2) = @_;
+
+ my $self = {};
+
+ if (defined($param1)
+ and ($param1 == constant("STD_INPUT_HANDLE", 0)
+ or $param1 == constant("STD_OUTPUT_HANDLE", 0)
+ or $param1 == constant("STD_ERROR_HANDLE", 0)))
+ {
+ $self->{'handle'} = _GetStdHandle($param1);
+ }
+ else {
+ $param1 = constant("GENERIC_READ", 0) | constant("GENERIC_WRITE", 0) unless $param1;
+ $param2 = constant("FILE_SHARE_READ", 0) | constant("FILE_SHARE_WRITE", 0) unless $param2;
+ $self->{'handle'} = _CreateConsoleScreenBuffer($param1, $param2,
+ constant("CONSOLE_TEXTMODE_BUFFER", 0));
+ }
+ bless $self, $class;
+ return $self;
+}
+
+#============
+sub Display {
+#============
+ my($self) = @_;
+ return undef unless ref($self);
+ return _SetConsoleActiveScreenBuffer($self->{'handle'});
+}
+
+#===========
+sub Select {
+#===========
+ my($self, $type) = @_;
+ return undef unless ref($self);
+ return _SetStdHandle($type, $self->{'handle'});
+}
+
+#===========
+sub SetIcon {
+#===========
+ my($self, $icon) = @_;
+ $icon = $self unless ref($self);
+ return _SetConsoleIcon($icon);
+}
+
+#==========
+sub Title {
+#==========
+ my($self, $title) = @_;
+ $title = $self unless ref($self);
+
+ if (defined($title)) {
+ return _SetConsoleTitle($title);
+ }
+ else {
+ return _GetConsoleTitle();
+ }
+}
+
+#==============
+sub WriteChar {
+#==============
+ my($self, $text, $col, $row) = @_;
+ return undef unless ref($self);
+ return _WriteConsoleOutputCharacter($self->{'handle'},$text,$col,$row);
+}
+
+#=============
+sub ReadChar {
+#=============
+ my($self, $size, $col, $row) = @_;
+ return undef unless ref($self);
+
+ my $buffer = (" " x $size);
+ if (_ReadConsoleOutputCharacter($self->{'handle'}, $buffer, $size, $col, $row)) {
+ return $buffer;
+ }
+ else {
+ return undef;
+ }
+}
+
+#==============
+sub WriteAttr {
+#==============
+ my($self, $attr, $col, $row) = @_;
+ return undef unless ref($self);
+ return _WriteConsoleOutputAttribute($self->{'handle'}, $attr, $col, $row);
+}
+
+#=============
+sub ReadAttr {
+#=============
+ my($self, $size, $col, $row) = @_;
+ return undef unless ref($self);
+ return _ReadConsoleOutputAttribute($self->{'handle'}, $size, $col, $row);
+}
+
+#==========
+sub Write {
+#==========
+ my($self,$string) = @_;
+ return undef unless ref($self);
+ return _WriteConsole($self->{'handle'}, $string);
+}
+
+#=============
+sub ReadRect {
+#=============
+ my($self, $left, $top, $right, $bottom) = @_;
+ return undef unless ref($self);
+
+ my $col = $right - $left + 1;
+ my $row = $bottom - $top + 1;
+
+ my $buffer = (" " x ($col*$row*4));
+ if (_ReadConsoleOutput($self->{'handle'}, $buffer,
+ $col, $row, 0, 0,
+ $left, $top, $right, $bottom))
+ {
+ return $buffer;
+ }
+ else {
+ return undef;
+ }
+}
+
+#==============
+sub WriteRect {
+#==============
+ my($self, $buffer, $left, $top, $right, $bottom) = @_;
+ return undef unless ref($self);
+
+ my $col = $right - $left + 1;
+ my $row = $bottom - $top + 1;
+
+ return _WriteConsoleOutput($self->{'handle'}, $buffer,
+ $col, $row, 0, 0,
+ $left, $top, $right, $bottom);
+}
+
+#===========
+sub Scroll {
+#===========
+ my($self, $left1, $top1, $right1, $bottom1,
+ $col, $row, $char, $attr,
+ $left2, $top2, $right2, $bottom2) = @_;
+ return undef unless ref($self);
+
+ return _ScrollConsoleScreenBuffer($self->{'handle'},
+ $left1, $top1, $right1, $bottom1,
+ $col, $row, $char, $attr,
+ $left2, $top2, $right2, $bottom2);
+}
+
+#==============
+sub MaxWindow {
+#==============
+ my($self, $flag) = @_;
+ return undef unless ref($self);
+
+ if (not defined($flag)) {
+ my @info = _GetConsoleScreenBufferInfo($self->{'handle'});
+ return $info[9], $info[10];
+ }
+ else {
+ return _GetLargestConsoleWindowSize($self->{'handle'});
+ }
+}
+
+#=========
+sub Info {
+#=========
+ my($self) = @_;
+ return undef unless ref($self);
+ return _GetConsoleScreenBufferInfo($self->{'handle'});
+}
+
+#===========
+sub Window {
+#===========
+ my($self, $flag, $left, $top, $right, $bottom) = @_;
+ return undef unless ref($self);
+
+ if (not defined($flag)) {
+ my @info = _GetConsoleScreenBufferInfo($self->{'handle'});
+ return $info[5], $info[6], $info[7], $info[8];
+ }
+ else {
+ return _SetConsoleWindowInfo($self->{'handle'}, $flag, $left, $top, $right, $bottom);
+ }
+}
+
+#==============
+sub GetEvents {
+#==============
+ my($self) = @_;
+ return undef unless ref($self);
+ return _GetNumberOfConsoleInputEvents($self->{'handle'});
+}
+
+#==========
+sub Flush {
+#==========
+ my($self) = @_;
+ return undef unless ref($self);
+ return _FlushConsoleInputBuffer($self->{'handle'});
+}
+
+#==============
+sub InputChar {
+#==============
+ my($self, $number) = @_;
+ return undef unless ref($self);
+
+ $number = 1 unless defined($number);
+
+ my $buffer = (" " x $number);
+ if (_ReadConsole($self->{'handle'}, $buffer, $number) == $number) {
+ return $buffer;
+ }
+ else {
+ return undef;
+ }
+}
+
+#==========
+sub Input {
+#==========
+ my($self) = @_;
+ return undef unless ref($self);
+ return _ReadConsoleInput($self->{'handle'});
+}
+
+#==============
+sub PeekInput {
+#==============
+ my($self) = @_;
+ return undef unless ref($self);
+ return _PeekConsoleInput($self->{'handle'});
+}
+
+#===============
+sub WriteInput {
+#===============
+ my($self) = shift;
+ return undef unless ref($self);
+ return _WriteConsoleInput($self->{'handle'}, @_);
+}
+
+#=========
+sub Mode {
+#=========
+ my($self, $mode) = @_;
+ return undef unless ref($self);
+ if (defined($mode)) {
+ return _SetConsoleMode($self->{'handle'}, $mode);
+ }
+ else {
+ return _GetConsoleMode($self->{'handle'});
+ }
+}
+
+#========
+sub Cls {
+#========
+ my($self, $attr) = @_;
+ return undef unless ref($self);
+
+ $attr = $ATTR_NORMAL unless defined($attr);
+
+ my ($x, $y) = $self->Size();
+ my($left, $top, $right ,$bottom) = $self->Window();
+ my $vx = $right - $left;
+ my $vy = $bottom - $top;
+ $self->FillChar(" ", $x*$y, 0, 0);
+ $self->FillAttr($attr, $x*$y, 0, 0);
+ $self->Cursor(0, 0);
+ $self->Window(1, 0, 0, $vx, $vy);
+}
+
+#=========
+sub Attr {
+#=========
+ my($self, $attr) = @_;
+ return undef unless ref($self);
+
+ if (not defined($attr)) {
+ return (_GetConsoleScreenBufferInfo($self->{'handle'}))[4];
+ }
+ else {
+ return _SetConsoleTextAttribute($self->{'handle'}, $attr);
+ }
+}
+
+#===========
+sub Cursor {
+#===========
+ my($self, $col, $row, $size, $visi) = @_;
+ return undef unless ref($self);
+
+ my $curr_row = 0;
+ my $curr_col = 0;
+ my $curr_size = 0;
+ my $curr_visi = 0;
+ my $return = 0;
+ my $discard = 0;
+
+
+ if (defined($col)) {
+ $row = -1 if not defined($row);
+ if ($col == -1 or $row == -1) {
+ ($discard, $discard, $curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
+ $col=$curr_col if $col==-1;
+ $row=$curr_row if $row==-1;
+ }
+ $return += _SetConsoleCursorPosition($self->{'handle'}, $col, $row);
+ if (defined($size) and defined($visi)) {
+ if ($size == -1 or $visi == -1) {
+ ($curr_size, $curr_visi) = _GetConsoleCursorInfo($self->{'handle'});
+ $size = $curr_size if $size == -1;
+ $visi = $curr_visi if $visi == -1;
+ }
+ $size = 1 if $size < 1;
+ $size = 99 if $size > 99;
+ $return += _SetConsoleCursorInfo($self->{'handle'}, $size, $visi);
+ }
+ return $return;
+ }
+ else {
+ ($discard, $discard, $curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
+ ($curr_size, $curr_visi) = _GetConsoleCursorInfo($self->{'handle'});
+ return ($curr_col, $curr_row, $curr_size, $curr_visi);
+ }
+}
+
+#=========
+sub Size {
+#=========
+ my($self, $col, $row) = @_;
+ return undef unless ref($self);
+
+ if (not defined($col)) {
+ ($col, $row) = _GetConsoleScreenBufferInfo($self->{'handle'});
+ return ($col, $row);
+ }
+ else {
+ $row = -1 if not defined($row);
+ if ($col == -1 or $row == -1) {
+ ($curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
+ $col=$curr_col if $col==-1;
+ $row=$curr_row if $row==-1;
+ }
+ return _SetConsoleScreenBufferSize($self->{'handle'}, $col, $row);
+ }
+}
+
+#=============
+sub FillAttr {
+#=============
+ my($self, $attr, $number, $col, $row) = @_;
+ return undef unless ref($self);
+
+ $number = 1 unless $number;
+
+ if (!defined($col) or !defined($row) or $col == -1 or $row == -1) {
+ ($discard, $discard,
+ $curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
+ $col = $curr_col if !defined($col) or $col == -1;
+ $row = $curr_row if !defined($row) or $row == -1;
+ }
+ return _FillConsoleOutputAttribute($self->{'handle'}, $attr, $number, $col, $row);
+}
+
+#=============
+sub FillChar {
+#=============
+ my($self, $char, $number, $col, $row) = @_;
+ return undef unless ref($self);
+
+ if (!defined($col) or !defined($row) or $col == -1 or $row == -1) {
+ ($discard, $discard,
+ $curr_col, $curr_row) = _GetConsoleScreenBufferInfo($self->{'handle'});
+ $col = $curr_col if !defined($col) or $col == -1;
+ $row = $curr_row if !defined($row) or $row == -1;
+ }
+ return _FillConsoleOutputCharacter($self->{'handle'}, $char, $number, $col, $row);
+}
+
+#============
+sub InputCP {
+#============
+ my($self, $codepage) = @_;
+ $codepage = $self if (defined($self) and ref($self) ne "Win32::Console");
+ if (defined($codepage)) {
+ return _SetConsoleCP($codepage);
+ }
+ else {
+ return _GetConsoleCP();
+ }
+}
+
+#=============
+sub OutputCP {
+#=============
+ my($self, $codepage) = @_;
+ $codepage = $self if (defined($self) and ref($self) ne "Win32::Console");
+ if (defined($codepage)) {
+ return _SetConsoleOutputCP($codepage);
+ }
+ else {
+ return _GetConsoleOutputCP();
+ }
+}
+
+#======================
+sub GenerateCtrlEvent {
+#======================
+ my($self, $type, $pid) = @_;
+ $type = constant("CTRL_C_EVENT", 0) unless defined($type);
+ $pid = 0 unless defined($pid);
+ return _GenerateConsoleCtrlEvent($type, $pid);
+}
+
+#===================
+#sub SetCtrlHandler {
+#===================
+# my($name, $add) = @_;
+# $add = 1 unless defined($add);
+# my @nor = keys(%HandlerRoutineStack);
+# if ($add == 0) {
+# foreach $key (@nor) {
+# delete $HandlerRoutineStack{$key}, last if $HandlerRoutineStack{$key}==$name;
+# }
+# $HandlerRoutineRegistered--;
+# } else {
+# if ($#nor == -1) {
+# my $r = _SetConsoleCtrlHandler();
+# if (!$r) {
+# print "WARNING: SetConsoleCtrlHandler failed...\n";
+# }
+# }
+# $HandlerRoutineRegistered++;
+# $HandlerRoutineStack{$HandlerRoutineRegistered} = $name;
+# }
+#}
+
+#===================
+sub get_Win32_IPC_HANDLE { # So Win32::IPC can wait on a console handle
+#===================
+ $_[0]->{'handle'};
+}
+
+########################################################################
+# PRIVATE METHODS
+#
+
+#================
+#sub CtrlHandler {
+#================
+# my($ctrltype) = @_;
+# my $routine;
+# my $result = 0;
+# CALLEM: foreach $routine (sort { $b <=> $a } keys %HandlerRoutineStack) {
+# #print "CtrlHandler: calling $HandlerRoutineStack{$routine}($ctrltype)\n";
+# $result = &{"main::".$HandlerRoutineStack{$routine}}($ctrltype);
+# last CALLEM if $result;
+# }
+# return $result;
+#}
+
+#============
+sub DESTROY {
+#============
+ my($self) = @_;
+ _CloseHandle($self->{'handle'});
+}
+
+#######################################################################
+# dynamically load in the Console.pll module.
+#
+
+bootstrap Win32::Console;
+
+#######################################################################
+# ADDITIONAL CONSTANTS EXPORTED IN THE MAIN NAMESPACE
+#
+
+$FG_BLACK = 0;
+$FG_GRAY = constant("FOREGROUND_INTENSITY",0);
+$FG_BLUE = constant("FOREGROUND_BLUE",0);
+$FG_LIGHTBLUE = constant("FOREGROUND_BLUE",0)|
+ constant("FOREGROUND_INTENSITY",0);
+$FG_RED = constant("FOREGROUND_RED",0);
+$FG_LIGHTRED = constant("FOREGROUND_RED",0)|
+ constant("FOREGROUND_INTENSITY",0);
+$FG_GREEN = constant("FOREGROUND_GREEN",0);
+$FG_LIGHTGREEN = constant("FOREGROUND_GREEN",0)|
+ constant("FOREGROUND_INTENSITY",0);
+$FG_MAGENTA = constant("FOREGROUND_RED",0)|
+ constant("FOREGROUND_BLUE",0);
+$FG_LIGHTMAGENTA = constant("FOREGROUND_RED",0)|
+ constant("FOREGROUND_BLUE",0)|
+ constant("FOREGROUND_INTENSITY",0);
+$FG_CYAN = constant("FOREGROUND_GREEN",0)|
+ constant("FOREGROUND_BLUE",0);
+$FG_LIGHTCYAN = constant("FOREGROUND_GREEN",0)|
+ constant("FOREGROUND_BLUE",0)|
+ constant("FOREGROUND_INTENSITY",0);
+$FG_BROWN = constant("FOREGROUND_RED",0)|
+ constant("FOREGROUND_GREEN",0);
+$FG_YELLOW = constant("FOREGROUND_RED",0)|
+ constant("FOREGROUND_GREEN",0)|
+ constant("FOREGROUND_INTENSITY",0);
+$FG_LIGHTGRAY = constant("FOREGROUND_RED",0)|
+ constant("FOREGROUND_GREEN",0)|
+ constant("FOREGROUND_BLUE",0);
+$FG_WHITE = constant("FOREGROUND_RED",0)|
+ constant("FOREGROUND_GREEN",0)|
+ constant("FOREGROUND_BLUE",0)|
+ constant("FOREGROUND_INTENSITY",0);
+
+$BG_BLACK = 0;
+$BG_GRAY = constant("BACKGROUND_INTENSITY",0);
+$BG_BLUE = constant("BACKGROUND_BLUE",0);
+$BG_LIGHTBLUE = constant("BACKGROUND_BLUE",0)|
+ constant("BACKGROUND_INTENSITY",0);
+$BG_RED = constant("BACKGROUND_RED",0);
+$BG_LIGHTRED = constant("BACKGROUND_RED",0)|
+ constant("BACKGROUND_INTENSITY",0);
+$BG_GREEN = constant("BACKGROUND_GREEN",0);
+$BG_LIGHTGREEN = constant("BACKGROUND_GREEN",0)|
+ constant("BACKGROUND_INTENSITY",0);
+$BG_MAGENTA = constant("BACKGROUND_RED",0)|
+ constant("BACKGROUND_BLUE",0);
+$BG_LIGHTMAGENTA = constant("BACKGROUND_RED",0)|
+ constant("BACKGROUND_BLUE",0)|
+ constant("BACKGROUND_INTENSITY",0);
+$BG_CYAN = constant("BACKGROUND_GREEN",0)|
+ constant("BACKGROUND_BLUE",0);
+$BG_LIGHTCYAN = constant("BACKGROUND_GREEN",0)|
+ constant("BACKGROUND_BLUE",0)|
+ constant("BACKGROUND_INTENSITY",0);
+$BG_BROWN = constant("BACKGROUND_RED",0)|
+ constant("BACKGROUND_GREEN",0);
+$BG_YELLOW = constant("BACKGROUND_RED",0)|
+ constant("BACKGROUND_GREEN",0)|
+ constant("BACKGROUND_INTENSITY",0);
+$BG_LIGHTGRAY = constant("BACKGROUND_RED",0)|
+ constant("BACKGROUND_GREEN",0)|
+ constant("BACKGROUND_BLUE",0);
+$BG_WHITE = constant("BACKGROUND_RED",0)|
+ constant("BACKGROUND_GREEN",0)|
+ constant("BACKGROUND_BLUE",0)|
+ constant("BACKGROUND_INTENSITY",0);
+
+$ATTR_NORMAL = $FG_LIGHTGRAY|$BG_BLACK;
+$ATTR_INVERSE = $FG_BLACK|$BG_LIGHTGRAY;
+
+for my $fg ($FG_BLACK, $FG_GRAY, $FG_BLUE, $FG_GREEN,
+ $FG_CYAN, $FG_RED, $FG_MAGENTA, $FG_BROWN,
+ $FG_LIGHTBLUE, $FG_LIGHTGREEN, $FG_LIGHTCYAN,
+ $FG_LIGHTRED, $FG_LIGHTMAGENTA, $FG_YELLOW,
+ $FG_LIGHTGRAY, $FG_WHITE)
+{
+ for my $bg ($BG_BLACK, $BG_GRAY, $BG_BLUE, $BG_GREEN,
+ $BG_CYAN, $BG_RED, $BG_MAGENTA, $BG_BROWN,
+ $BG_LIGHTBLUE, $BG_LIGHTGREEN, $BG_LIGHTCYAN,
+ $BG_LIGHTRED, $BG_LIGHTMAGENTA, $BG_YELLOW,
+ $BG_LIGHTGRAY, $BG_WHITE)
+ {
+ push(@CONSOLE_COLORS, $fg|$bg);
+ }
+}
+
+# Preloaded methods go here.
+
+#Currently Autoloading is not implemented in Perl for win32
+# Autoload methods go after __END__, and are processed by the autosplit program.
+
+1;
+
+__END__
+
+=head1 NAME
+
+Win32::Console - Win32 Console and Character Mode Functions
+
+
+=head1 DESCRIPTION
+
+This module implements the Win32 console and character mode
+functions. They give you full control on the console input and output,
+including: support of off-screen console buffers (eg. multiple screen
+pages)
+
+=over
+
+=item *
+
+reading and writing of characters, attributes and whole portions of
+the screen
+
+=item *
+
+complete processing of keyboard and mouse events
+
+=item *
+
+some very funny additional features :)
+
+=back
+
+Those functions should also make possible a port of the Unix's curses
+library; if there is anyone interested (and/or willing to contribute)
+to this project, e-mail me. Thank you.
+
+
+=head1 REFERENCE
+
+
+=head2 Methods
+
+=over
+
+=item Alloc
+
+Allocates a new console for the process. Returns C<undef> on errors, a
+nonzero value on success. A process cannot be associated with more
+than one console, so this method will fail if there is already an
+allocated console. Use Free to detach the process from the console,
+and then call Alloc to create a new console. See also: C<Free>
+
+Example:
+
+ $CONSOLE->Alloc();
+
+=item Attr [attr]
+
+Gets or sets the current console attribute. This attribute is used by
+the Write method.
+
+Example:
+
+ $attr = $CONSOLE->Attr();
+ $CONSOLE->Attr($FG_YELLOW | $BG_BLUE);
+
+=item Close
+
+Closes a shortcut object. Note that it is not "strictly" required to
+close the objects you created, since the Win32::Shortcut objects are
+automatically closed when the program ends (or when you somehow
+destroy such an object).
+
+Example:
+
+ $LINK->Close();
+
+=item Cls [attr]
+
+Clear the console, with the specified I<attr> if given, or using
+ATTR_NORMAL otherwise.
+
+Example:
+
+ $CONSOLE->Cls();
+ $CONSOLE->Cls($FG_WHITE | $BG_GREEN);
+
+=item Cursor [x, y, size, visible]
+
+Gets or sets cursor position and appearance. Returns C<undef> on
+errors, or a 4-element list containing: I<x>, I<y>, I<size>,
+I<visible>. I<x> and I<y> are the current cursor position; ...
+
+Example:
+
+ ($x, $y, $size, $visible) = $CONSOLE->Cursor();
+
+ # Get position only
+ ($x, $y) = $CONSOLE->Cursor();
+
+ $CONSOLE->Cursor(40, 13, 50, 1);
+
+ # Set position only
+ $CONSOLE->Cursor(40, 13);
+
+ # Set size and visibility without affecting position
+ $CONSOLE->Cursor(-1, -1, 50, 1);
+
+=item Display
+
+Displays the specified console on the screen. Returns C<undef> on errors,
+a nonzero value on success.
+
+Example:
+
+ $CONSOLE->Display();
+
+=item FillAttr [attribute, number, col, row]
+
+Fills the specified number of consecutive attributes, beginning at
+I<col>, I<row>, with the value specified in I<attribute>. Returns the
+number of attributes filled, or C<undef> on errors. See also:
+C<FillChar>.
+
+Example:
+
+ $CONSOLE->FillAttr($FG_BLACK | $BG_BLACK, 80*25, 0, 0);
+
+=item FillChar char, number, col, row
+
+Fills the specified number of consecutive characters, beginning at
+I<col>, I<row>, with the character specified in I<char>. Returns the
+number of characters filled, or C<undef> on errors. See also:
+C<FillAttr>.
+
+Example:
+
+ $CONSOLE->FillChar("X", 80*25, 0, 0);
+
+=item Flush
+
+Flushes the console input buffer. All the events in the buffer are
+discarded. Returns C<undef> on errors, a nonzero value on success.
+
+Example:
+
+ $CONSOLE->Flush();
+
+=item Free
+
+Detaches the process from the console. Returns C<undef> on errors, a
+nonzero value on success. See also: C<Alloc>.
+
+Example:
+
+ $CONSOLE->Free();
+
+=item GenerateCtrlEvent [type, processgroup]
+
+Sends a break signal of the specified I<type> to the specified
+I<processgroup>. I<type> can be one of the following constants:
+
+ CTRL_BREAK_EVENT
+ CTRL_C_EVENT
+
+they signal, respectively, the pressing of Control + Break and of
+Control + C; if not specified, it defaults to CTRL_C_EVENT.
+I<processgroup> is the pid of a process sharing the same console. If
+omitted, it defaults to 0 (the current process), which is also the
+only meaningful value that you can pass to this function. Returns
+C<undef> on errors, a nonzero value on success.
+
+Example:
+
+ # break this script now
+ $CONSOLE->GenerateCtrlEvent();
+
+=item GetEvents
+
+Returns the number of unread input events in the console's input
+buffer, or C<undef> on errors. See also: C<Input>, C<InputChar>,
+C<PeekInput>, C<WriteInput>.
+
+Example:
+
+ $events = $CONSOLE->GetEvents();
+
+=item Info
+
+Returns an array of informations about the console (or C<undef> on
+errors), which contains:
+
+=over
+
+=item *
+
+columns (X size) of the console buffer.
+
+=item *
+
+rows (Y size) of the console buffer.
+
+=item *
+
+current column (X position) of the cursor.
+
+=item *
+
+current row (Y position) of the cursor.
+
+=item *
+
+current attribute used for C<Write>.
+
+=item *
+
+left column (X of the starting point) of the current console window.
+
+=item *
+
+top row (Y of the starting point) of the current console window.
+
+=item *
+
+right column (X of the final point) of the current console window.
+
+=item *
+
+bottom row (Y of the final point) of the current console window.
+
+=item *
+
+maximum number of columns for the console window, given the current
+buffer size, font and the screen size.
+
+=item *
+
+maximum number of rows for the console window, given the current
+buffer size, font and the screen size.
+
+=back
+
+See also: C<Attr>, C<Cursor>, C<Size>, C<Window>, C<MaxWindow>.
+
+Example:
+
+ @info = $CONSOLE->Info();
+ print "Cursor at $info[3], $info[4].\n";
+
+=item Input
+
+Reads an event from the input buffer. Returns a list of values, which
+depending on the event's nature are:
+
+=over
+
+=item keyboard event
+
+The list will contain:
+
+=over
+
+=item *
+
+event type: 1 for keyboard
+
+=item *
+
+key down: TRUE if the key is being pressed, FALSE if the key is being released
+
+=item *
+
+repeat count: the number of times the key is being held down
+
+=item *
+
+virtual keycode: the virtual key code of the key
+
+=item *
+
+virtual scancode: the virtual scan code of the key
+
+=item *
+
+char: the ASCII code of the character (if the key is a character key, 0 otherwise)
+
+=item *
+
+control key state: the state of the control keys (SHIFTs, CTRLs, ALTs, etc.)
+
+=back
+
+=item mouse event
+
+The list will contain:
+
+=over
+
+=item *
+
+event type: 2 for mouse
+
+=item *
+
+mouse pos. X: X coordinate (column) of the mouse location
+
+=item *
+
+mouse pos. Y: Y coordinate (row) of the mouse location
+
+=item *
+
+button state: the mouse button(s) which are pressed
+
+=item *
+
+control key state: the state of the control keys (SHIFTs, CTRLs, ALTs, etc.)
+
+=item *
+
+event flags: the type of the mouse event
+
+=back
+
+=back
+
+This method will return C<undef> on errors. Note that the events
+returned are depending on the input C<Mode> of the console; for example,
+mouse events are not intercepted unless ENABLE_MOUSE_INPUT is
+specified. See also: C<GetEvents>, C<InputChar>, C<Mode>,
+C<PeekInput>, C<WriteInput>.
+
+Example:
+
+ @event = $CONSOLE->Input();
+
+=item InputChar number
+
+Reads and returns I<number> characters from the console input buffer,
+or C<undef> on errors. See also: C<Input>, C<Mode>.
+
+Example:
+
+ $key = $CONSOLE->InputChar(1);
+
+=item InputCP [codepage]
+
+Gets or sets the input code page used by the console. Note that this
+doesn't apply to a console object, but to the standard input
+console. This attribute is used by the Write method. See also:
+C<OutputCP>.
+
+Example:
+
+ $codepage = $CONSOLE->InputCP();
+ $CONSOLE->InputCP(437);
+
+ # you may want to use the non-instanciated form to avoid confuzion :)
+ $codepage = Win32::Console::InputCP();
+ Win32::Console::InputCP(437);
+
+=item MaxWindow
+
+Returns the size of the largest possible console window, based on the
+current font and the size of the display. The result is C<undef> on
+errors, otherwise a 2-element list containing col, row.
+
+Example:
+
+ ($maxCol, $maxRow) = $CONSOLE->MaxWindow();
+
+=item Mode [flags]
+
+Gets or sets the input or output mode of a console. I<flags> can be a
+combination of the following constants:
+
+ ENABLE_LINE_INPUT
+ ENABLE_ECHO_INPUT
+ ENABLE_PROCESSED_INPUT
+ ENABLE_WINDOW_INPUT
+ ENABLE_MOUSE_INPUT
+ ENABLE_PROCESSED_OUTPUT
+ ENABLE_WRAP_AT_EOL_OUTPUT
+
+For more informations on the meaning of those flags, please refer to
+the L<"Microsoft's Documentation">.
+
+Example:
+
+ $mode = $CONSOLE->Mode();
+ $CONSOLE->Mode(ENABLE_MOUSE_INPUT | ENABLE_PROCESSED_INPUT);
+
+=item MouseButtons
+
+Returns the number of the buttons on your mouse, or C<undef> on errors.
+
+Example:
+
+ print "Your mouse has ", $CONSOLE->MouseButtons(), " buttons.\n";
+
+=item new Win32::Console standard_handle
+
+=item new Win32::Console [accessmode, sharemode]
+
+Creates a new console object. The first form creates a handle to a
+standard channel, I<standard_handle> can be one of the following:
+
+ STD_OUTPUT_HANDLE
+ STD_ERROR_HANDLE
+ STD_INPUT_HANDLE
+
+The second form, instead, creates a console screen buffer in memory,
+which you can access for reading and writing as a normal console, and
+then redirect on the standard output (the screen) with C<Display>. In
+this case, you can specify one or both of the following values for
+I<accessmode>:
+
+ GENERIC_READ
+ GENERIC_WRITE
+
+which are the permissions you will have on the created buffer, and one
+or both of the following values for I<sharemode>:
+
+ FILE_SHARE_READ
+ FILE_SHARE_WRITE
+
+which affect the way the console can be shared. If you don't specify
+any of those parameters, all 4 flags will be used.
+
+Example:
+
+ $STDOUT = new Win32::Console(STD_OUTPUT_HANDLE);
+ $STDERR = new Win32::Console(STD_ERROR_HANDLE);
+ $STDIN = new Win32::Console(STD_INPUT_HANDLE);
+
+ $BUFFER = new Win32::Console();
+ $BUFFER = new Win32::Console(GENERIC_READ | GENERIC_WRITE);
+
+=item OutputCP [codepage]
+
+Gets or sets the output code page used by the console. Note that this
+doesn't apply to a console object, but to the standard output console.
+See also: C<InputCP>.
+
+Example:
+
+ $codepage = $CONSOLE->OutputCP();
+ $CONSOLE->OutputCP(437);
+
+ # you may want to use the non-instanciated form to avoid confuzion :)
+ $codepage = Win32::Console::OutputCP();
+ Win32::Console::OutputCP(437);
+
+=item PeekInput
+
+Does exactly the same as C<Input>, except that the event read is not
+removed from the input buffer. See also: C<GetEvents>, C<Input>,
+C<InputChar>, C<Mode>, C<WriteInput>.
+
+Example:
+
+ @event = $CONSOLE->PeekInput();
+
+=item ReadAttr [number, col, row]
+
+Reads the specified I<number> of consecutive attributes, beginning at
+I<col>, I<row>, from the console. Returns the attributes read (a
+variable containing one character for each attribute), or C<undef> on
+errors. You can then pass the returned variable to C<WriteAttr> to
+restore the saved attributes on screen. See also: C<ReadChar>,
+C<ReadRect>.
+
+Example:
+
+ $colors = $CONSOLE->ReadAttr(80*25, 0, 0);
+
+=item ReadChar [number, col, row]
+
+Reads the specified I<number> of consecutive characters, beginning at
+I<col>, I<row>, from the console. Returns a string containing the
+characters read, or C<undef> on errors. You can then pass the
+returned variable to C<WriteChar> to restore the saved characters on
+screen. See also: C<ReadAttr>, C<ReadRect>.
+
+Example:
+
+ $chars = $CONSOLE->ReadChar(80*25, 0, 0);
+
+=item ReadRect left, top, right, bottom
+
+Reads the content (characters and attributes) of the rectangle
+specified by I<left>, I<top>, I<right>, I<bottom> from the console.
+Returns a string containing the rectangle read, or C<undef> on errors.
+You can then pass the returned variable to C<WriteRect> to restore the
+saved rectangle on screen (or on another console). See also:
+C<ReadAttr>, C<ReadChar>.
+
+Example:
+
+ $rect = $CONSOLE->ReadRect(0, 0, 80, 25);
+
+=item Scroll left, top, right, bottom, col, row, char, attr,
+ [cleft, ctop, cright, cbottom]
+
+Moves a block of data in a console buffer; the block is identified by
+I<left>, I<top>, I<right>, I<bottom>, while I<row>, I<col> identify
+the new location of the block. The cells left empty as a result of
+the move are filled with the character I<char> and attribute I<attr>.
+Optionally you can specify a clipping region with I<cleft>, I<ctop>,
+I<cright>, I<cbottom>, so that the content of the console outside this
+rectangle are unchanged. Returns C<undef> on errors, a nonzero value
+on success.
+
+Example:
+
+ # scrolls the screen 10 lines down, filling with black spaces
+ $CONSOLE->Scroll(0, 0, 80, 25, 0, 10, " ", $FG_BLACK | $BG_BLACK);
+
+=item Select standard_handle
+
+Redirects a standard handle to the specified console.
+I<standard_handle> can have one of the following values:
+
+ STD_INPUT_HANDLE
+ STD_OUTPUT_HANDLE
+ STD_ERROR_HANDLE
+
+Returns C<undef> on errors, a nonzero value on success.
+
+Example:
+
+ $CONSOLE->Select(STD_OUTPUT_HANDLE);
+
+=item SetIcon icon_file
+
+Sets the icon in the title bar of the current console window.
+
+Example:
+
+ $CONSOLE->SetIcon("C:/My/Path/To/Custom.ico");
+
+=item Size [col, row]
+
+Gets or sets the console buffer size.
+
+Example:
+
+ ($x, $y) = $CONSOLE->Size();
+ $CONSOLE->Size(80, 25);
+
+=item Title [title]
+
+Gets or sets the title of the current console window.
+
+Example:
+
+ $title = $CONSOLE->Title();
+ $CONSOLE->Title("This is a title");
+
+=item Window [flag, left, top, right, bottom]
+
+Gets or sets the current console window size. If called without
+arguments, returns a 4-element list containing the current window
+coordinates in the form of I<left>, I<top>, I<right>, I<bottom>. To
+set the window size, you have to specify an additional I<flag>
+parameter: if it is 0 (zero), coordinates are considered relative to
+the current coordinates; if it is non-zero, coordinates are absolute.
+
+Example:
+
+ ($left, $top, $right, $bottom) = $CONSOLE->Window();
+ $CONSOLE->Window(1, 0, 0, 80, 50);
+
+=item Write string
+
+Writes I<string> on the console, using the current attribute, that you
+can set with C<Attr>, and advancing the cursor as needed. This isn't
+so different from Perl's "print" statement. Returns the number of
+characters written or C<undef> on errors. See also: C<WriteAttr>,
+C<WriteChar>, C<WriteRect>.
+
+Example:
+
+ $CONSOLE->Write("Hello, world!");
+
+=item WriteAttr attrs, col, row
+
+Writes the attributes in the string I<attrs>, beginning at I<col>,
+I<row>, without affecting the characters that are on screen. The
+string attrs can be the result of a C<ReadAttr> function, or you can
+build your own attribute string; in this case, keep in mind that every
+attribute is treated as a character, not a number (see example).
+Returns the number of attributes written or C<undef> on errors. See
+also: C<Write>, C<WriteChar>, C<WriteRect>.
+
+Example:
+
+ $CONSOLE->WriteAttr($attrs, 0, 0);
+
+ # note the use of chr()...
+ $attrs = chr($FG_BLACK | $BG_WHITE) x 80;
+ $CONSOLE->WriteAttr($attrs, 0, 0);
+
+=item WriteChar chars, col, row
+
+Writes the characters in the string I<attr>, beginning at I<col>, I<row>,
+without affecting the attributes that are on screen. The string I<chars>
+can be the result of a C<ReadChar> function, or a normal string. Returns
+the number of characters written or C<undef> on errors. See also:
+C<Write>, C<WriteAttr>, C<WriteRect>.
+
+Example:
+
+ $CONSOLE->WriteChar("Hello, worlds!", 0, 0);
+
+=item WriteInput (event)
+
+Pushes data in the console input buffer. I<(event)> is a list of values,
+for more information see C<Input>. The string chars can be the result of
+a C<ReadChar> function, or a normal string. Returns the number of
+characters written or C<undef> on errors. See also: C<Write>,
+C<WriteAttr>, C<WriteRect>.
+
+Example:
+
+ $CONSOLE->WriteInput(@event);
+
+=item WriteRect rect, left, top, right, bottom
+
+Writes a rectangle of characters and attributes (contained in I<rect>)
+on the console at the coordinates specified by I<left>, I<top>,
+I<right>, I<bottom>. I<rect> can be the result of a C<ReadRect>
+function. Returns C<undef> on errors, otherwise a 4-element list
+containing the coordinates of the affected rectangle, in the format
+I<left>, I<top>, I<right>, I<bottom>. See also: C<Write>,
+C<WriteAttr>, C<WriteChar>.
+
+Example:
+
+ $CONSOLE->WriteRect($rect, 0, 0, 80, 25);
+
+=back
+
+
+=head2 Constants
+
+The following constants are exported in the main namespace of your
+script using Win32::Console:
+
+ BACKGROUND_BLUE
+ BACKGROUND_GREEN
+ BACKGROUND_INTENSITY
+ BACKGROUND_RED
+ CAPSLOCK_ON
+ CONSOLE_TEXTMODE_BUFFER
+ ENABLE_ECHO_INPUT
+ ENABLE_LINE_INPUT
+ ENABLE_MOUSE_INPUT
+ ENABLE_PROCESSED_INPUT
+ ENABLE_PROCESSED_OUTPUT
+ ENABLE_WINDOW_INPUT
+ ENABLE_WRAP_AT_EOL_OUTPUT
+ ENHANCED_KEY
+ FILE_SHARE_READ
+ FILE_SHARE_WRITE
+ FOREGROUND_BLUE
+ FOREGROUND_GREEN
+ FOREGROUND_INTENSITY
+ FOREGROUND_RED
+ LEFT_ALT_PRESSED
+ LEFT_CTRL_PRESSED
+ NUMLOCK_ON
+ GENERIC_READ
+ GENERIC_WRITE
+ RIGHT_ALT_PRESSED
+ RIGHT_CTRL_PRESSED
+ SCROLLLOCK_ON
+ SHIFT_PRESSED
+ STD_INPUT_HANDLE
+ STD_OUTPUT_HANDLE
+ STD_ERROR_HANDLE
+
+Additionally, the following variables can be used:
+
+ $FG_BLACK
+ $FG_GRAY
+ $FG_BLUE
+ $FG_LIGHTBLUE
+ $FG_RED
+ $FG_LIGHTRED
+ $FG_GREEN
+ $FG_LIGHTGREEN
+ $FG_MAGENTA
+ $FG_LIGHTMAGENTA
+ $FG_CYAN
+ $FG_LIGHTCYAN
+ $FG_BROWN
+ $FG_YELLOW
+ $FG_LIGHTGRAY
+ $FG_WHITE
+
+ $BG_BLACK
+ $BG_GRAY
+ $BG_BLUE
+ $BG_LIGHTBLUE
+ $BG_RED
+ $BG_LIGHTRED
+ $BG_GREEN
+ $BG_LIGHTGREEN
+ $BG_MAGENTA
+ $BG_LIGHTMAGENTA
+ $BG_CYAN
+ $BG_LIGHTCYAN
+ $BG_BROWN
+ $BG_YELLOW
+ $BG_LIGHTGRAY
+ $BG_WHITE
+
+ $ATTR_NORMAL
+ $ATTR_INVERSE
+
+ATTR_NORMAL is set to gray foreground on black background (DOS's
+standard colors).
+
+
+=head2 Microsoft's Documentation
+
+Documentation for the Win32 Console and Character mode Functions can
+be found on Microsoft's site at this URL:
+
+http://www.microsoft.com/msdn/sdk/platforms/doc/sdk/win32/sys/src/conchar.htm
+
+A reference of the available functions is at:
+
+http://www.microsoft.com/msdn/sdk/platforms/doc/sdk/win32/sys/src/conchar_34.htm
+
+
+=head1 AUTHOR
+
+Aldo Calpini <a.calpini@romagiubileo.it>
+
+=head1 CREDITS
+
+Thanks to: Jesse Dougherty, Dave Roth, ActiveWare, and the
+Perl-Win32-Users community.
+
+=head1 DISCLAIMER
+
+This program is FREE; you can redistribute, modify, disassemble, or
+even reverse engineer this software at your will. Keep in mind,
+however, that NOTHING IS GUARANTEED to work and everything you do is
+AT YOUR OWN RISK - I will not take responsibility for any damage, loss
+of money and/or health that may arise from the use of this program!
+
+This is distributed under the terms of Larry Wall's Artistic License.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE.pm
new file mode 100644
index 0000000000..ece534b15f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE.pm
@@ -0,0 +1,968 @@
+# The documentation is at the __END__
+
+package Win32::OLE;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK @EXPORT_FAIL $AUTOLOAD
+ $CP $LCID $Warn $LastError $_NewEnum $_Unique);
+
+$VERSION = '0.1712';
+
+use Carp;
+use Exporter;
+use DynaLoader;
+@ISA = qw(Exporter DynaLoader);
+
+@EXPORT = qw();
+@EXPORT_OK = qw(in valof with HRESULT EVENTS OVERLOAD
+ CP_ACP CP_OEMCP CP_MACCP CP_UTF7 CP_UTF8
+ DISPATCH_METHOD DISPATCH_PROPERTYGET
+ DISPATCH_PROPERTYPUT DISPATCH_PROPERTYPUTREF);
+@EXPORT_FAIL = qw(EVENTS OVERLOAD);
+
+sub export_fail {
+ shift;
+ my @unknown;
+ while (@_) {
+ my $symbol = shift;
+ if ($symbol eq 'OVERLOAD') {
+ eval <<'OVERLOAD';
+ use overload '""' => \&valof,
+ '0+' => \&valof,
+ fallback => 1;
+OVERLOAD
+ }
+ elsif ($symbol eq 'EVENTS') {
+ Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE());
+ }
+ else {
+ push @unknown, $symbol;
+ }
+ }
+ return @unknown;
+}
+
+unless (defined &Dispatch) {
+ # Use regular DynaLoader if XS part is not yet initialized
+ bootstrap Win32::OLE;
+ require Win32::OLE::Lite;
+}
+
+1;
+
+########################################################################
+
+__END__
+
+=head1 NAME
+
+Win32::OLE - OLE Automation extensions
+
+=head1 SYNOPSIS
+
+ $ex = Win32::OLE->new('Excel.Application') or die "oops\n";
+ $ex->Amethod("arg")->Bmethod->{'Property'} = "foo";
+ $ex->Cmethod(undef,undef,$Arg3);
+ $ex->Dmethod($RequiredArg1, {NamedArg1 => $Value1, NamedArg2 => $Value2});
+
+ $wd = Win32::OLE->GetObject("D:\\Data\\Message.doc");
+ $xl = Win32::OLE->GetActiveObject("Excel.Application");
+
+=head1 DESCRIPTION
+
+This module provides an interface to OLE Automation from Perl.
+OLE Automation brings VisualBasic like scripting capabilities and
+offers powerful extensibility and the ability to control many Win32
+applications from Perl scripts.
+
+The Win32::OLE module uses the IDispatch interface exclusively. It is
+not possible to access a custom OLE interface. OLE events and OCX's are
+currently not supported.
+
+Actually, that's no longer strictly true. This module now contains
+B<ALPHA> level support for OLE events. This is largely untested and the
+specific interface might still change in the future.
+
+=head2 Methods
+
+=over 8
+
+=item Win32::OLE->new(PROGID[, DESTRUCTOR])
+
+The new() class method starts a new instance of an OLE Automation object.
+It returns a reference to this object or C<undef> if the creation failed.
+
+The PROGID argument must be either the OLE I<program id> or the I<class id>
+of the required application. The optional DESTRUCTOR specifies a DESTROY-like
+method. This can be either a CODE reference or a string containing an OLE
+method name. It can be used to cleanly terminate OLE applications in case the
+Perl program dies.
+
+To create an object via DCOM on a remote server you can use an array
+reference in place of PROGID. The referenced array must contain the
+machine name and the I<program id> or I<class id>. For example:
+
+ my $obj = Win32::OLE->new(['my.machine.com', 'Program.Id']);
+
+If the PROGID is a I<program id> then Win32::OLE will try to resolve the
+corresponding I<class id> locally. If the I<program id> is not registered
+locally then the remote registry is queried. This will only succeed if
+the local process has read access to the remote registry. The safest
+(and fastest) method is to specify the C<class id> directly.
+
+=item Win32::OLE->EnumAllObjects([CALLBACK])
+
+This class method returns the number Win32::OLE objects currently in
+existence. It will call the optional CALLBACK function for each of
+these objects:
+
+ $Count = Win32::OLE->EnumAllObjects(sub {
+ my $Object = shift;
+ my $Class = Win32::OLE->QueryObjectType($Object);
+ printf "# Object=%s Class=%s\n", $Object, $Class;
+ });
+
+The EnumAllObjects() method is primarily a debugging tool. It can be
+used e.g. in an END block to check if all external connections have
+been properly destroyed.
+
+=item Win32::OLE->FreeUnusedLibraries()
+
+The FreeUnusedLibraries() class method unloads all unused OLE
+resources. These are the libraries of those classes of which all
+existing objects have been destroyed. The unloading of object
+libraries is really only important for long running processes that
+might instantiate a huge number of B<different> objects over time.
+
+Be aware that objects implemented in Visual Basic have a buggy
+implementation of this functionality: They pretend to be unloadable
+while they are actually still running their cleanup code. Unloading
+the DLL at that moment typically produces an access violation. The
+probability for this problem can be reduced by calling the
+SpinMessageLoop() method and sleep()ing for a few seconds.
+
+=item Win32::OLE->GetActiveObject(CLASS[, DESTRUCTOR])
+
+The GetActiveObject() class method returns an OLE reference to a
+running instance of the specified OLE automation server. It returns
+C<undef> if the server is not currently active. It will croak if
+the class is not even registered. The optional DESTRUCTOR method takes
+either a method name or a code reference. It is executed when the last
+reference to this object goes away. It is generally considered rude
+to stop applications that you did not start yourself.
+
+=item Win32::OLE->GetObject(MONIKER[, DESTRUCTOR])
+
+The GetObject() class method returns an OLE reference to the specified
+object. The object is specified by a pathname optionally followed by
+additional item subcomponent separated by exclamation marks '!'. The
+optional DESTRUCTOR argument has the same semantics as the DESTRUCTOR in
+new() or GetActiveObject().
+
+=item Win32::OLE->Initialize([COINIT])
+
+The Initialize() class method can be used to specify an alternative
+apartment model for the Perl thread. It must be called B<before> the
+first OLE object is created. If the C<Win32::OLE::Const> module is
+used then the call to the Initialize() method must be made from a BEGIN
+block before the first C<use> statement for the C<Win32::OLE::Const>
+module.
+
+Valid values for COINIT are:
+
+ Win32::OLE::COINIT_APARTMENTTHREADED - single threaded
+ Win32::OLE::COINIT_MULTITHREADED - the default
+ Win32::OLE::COINIT_OLEINITIALIZE - single threaded, additional OLE stuff
+
+COINIT_OLEINITIALIZE is sometimes needed when an OLE object uses
+additional OLE compound document technologies not available from the
+normal COM subsystem (for example MAPI.Session seems to require it).
+Both COINIT_OLEINITIALIZE and COINIT_APARTMENTTHREADED create a hidden
+top level window and a message queue for the Perl process. This may
+create problems with other application, because Perl normally doesn't
+process its message queue. This means programs using synchronous
+communication between applications (such as DDE initiation), may hang
+until Perl makes another OLE method call/property access or terminates.
+This applies to InstallShield setups and many things started to shell
+associations. Please try to utilize the C<Win32::OLE-E<gt>SpinMessageLoop>
+and C<Win32::OLE-E<gt>Uninitialize> methods if you can not use the default
+COINIT_MULTITHREADED model.
+
+=item OBJECT->Invoke(METHOD[, ARGS])
+
+The Invoke() object method is an alternate way to invoke OLE
+methods. It is normally equivalent to C<$OBJECT-E<gt>METHOD(@ARGS)>. This
+function must be used if the METHOD name contains characters not valid
+in a Perl variable name (like foreign language characters). It can
+also be used to invoke the default method of an object even if the
+default method has not been given a name in the type library. In this
+case use <undef> or C<''> as the method name. To invoke an OLE objects
+native Invoke() method (if such a thing exists), please use:
+
+ $Object->Invoke('Invoke', @Args);
+
+=item Win32::OLE->LastError()
+
+The LastError() class method returns the last recorded OLE
+error. This is a dual value like the C<$!> variable: in a numeric
+context it returns the error number and in a string context it returns
+the error message. The error number is a signed HRESULT value. Please
+use the L<HRESULT(ERROR)> function to convert an unsigned hexadecimal
+constant to a signed HRESULT.
+
+The last OLE error is automatically reset by a successful OLE
+call. The numeric value can also explicitly be set by a call (which will
+discard the string value):
+
+ Win32::OLE->LastError(0);
+
+=item OBJECT->LetProperty(NAME,ARGS,VALUE)
+
+In Win32::OLE property assignment using the hash syntax is equivalent
+to the Visual Basic C<Set> syntax (I<by reference> assignment):
+
+ $Object->{Property} = $OtherObject;
+
+corresponds to this Visual Basic statement:
+
+ Set Object.Property = OtherObject
+
+To get the I<by value> treatment of the Visual Basic C<Let> statement
+
+ Object.Property = OtherObject
+
+you have to use the LetProperty() object method in Perl:
+
+ $Object->LetProperty($Property, $OtherObject);
+
+LetProperty() also supports optional arguments for the property assignment.
+See L<OBJECT->SetProperty(NAME,ARGS,VALUE)> for details.
+
+=item Win32::OLE->MessageLoop()
+
+The MessageLoop() class method will run a standard Windows message
+loop, dispatching messages until the QuitMessageLoop() class method is
+called. It is used to wait for OLE events.
+
+=item Win32::OLE->Option(OPTION)
+
+The Option() class method can be used to inspect and modify
+L<Module Options>. The single argument form retrieves the value of
+an option:
+
+ my $CP = Win32::OLE->Option('CP');
+
+A single call can be used to set multiple options simultaneously:
+
+ Win32::OLE->Option(CP => CP_ACP, Warn => 3);
+
+=item Win32::OLE->QueryObjectType(OBJECT)
+
+The QueryObjectType() class method returns a list of the type library
+name and the objects class name. In a scalar context it returns the
+class name only. It returns C<undef> when the type information is not
+available.
+
+=item Win32::OLE->QuitMessageLoop()
+
+The QuitMessageLoop() class method posts a (user-level) "Quit" message
+to the current threads message loop. QuitMessageLoop() is typically
+called from an event handler. The MessageLoop() class method will
+return when it receives this "Quit" method.
+
+=item OBJECT->SetProperty(NAME,ARGS,VALUE)
+
+The SetProperty() method allows to modify properties with arguments,
+which is not supported by the hash syntax. The hash form
+
+ $Object->{Property} = $Value;
+
+is equivalent to
+
+ $Object->SetProperty('Property', $Value);
+
+Arguments must be specified between the property name and the new value:
+
+ $Object->SetProperty('Property', @Args, $Value);
+
+It is not possible to use "named argument" syntax with this function
+because the new value must be the last argument to SetProperty().
+
+This method hides any native OLE object method called SetProperty().
+The native method will still be available through the Invoke() method:
+
+ $Object->Invoke('SetProperty', @Args);
+
+=item Win32::OLE->SpinMessageLoop
+
+This class method retrieves all pending messages from the message queue
+and dispatches them to their respective window procedures. Calling this
+method is only necessary when not using the COINIT_MULTITHREADED model.
+All OLE method calls and property accesses automatically process the
+message queue.
+
+=item Win32::OLE->Uninitialize
+
+The Uninitialize() class method uninitializes the OLE subsystem. It
+also destroys the hidden top level window created by OLE for single
+threaded apartments. All OLE objects will become invalid after this call!
+It is possible to call the Initialize() class method again with a different
+apartment model after shutting down OLE with Uninitialize().
+
+=item Win32::OLE->WithEvents(OBJECT[, HANDLER[, INTERFACE]])
+
+This class method enables and disables the firing of events by the
+specified OBJECT. If no HANDLER is specified, then events are
+disconnected. For some objects Win32::OLE is not able to
+automatically determine the correct event interface. In this case the
+INTERFACE argument must contain either the COCLASS name of the OBJECT
+or the name of the event DISPATCH interface. Please read the L<Events>
+section below for detailed explanation of the Win32::OLE event
+support.
+
+=back
+
+Whenever Perl does not find a method name in the Win32::OLE package it
+is automatically used as the name of an OLE method and this method call
+is dispatched to the OLE server.
+
+There is one special hack built into the module: If a method or property
+name could not be resolved with the OLE object, then the default method
+of the object is called with the method name as its first parameter. So
+
+ my $Sheet = $Worksheets->Table1;
+or
+ my $Sheet = $Worksheets->{Table1};
+
+is resolved as
+
+ my $Sheet = $Worksheet->Item('Table1');
+
+provided that the $Worksheets object does not have a C<Table1> method
+or property. This hack has been introduced to call the default method
+of collections which did not name the method in their type library. The
+recommended way to call the "unnamed" default method is:
+
+ my $Sheet = $Worksheets->Invoke('', 'Table1');
+
+This special hack is disabled under C<use strict 'subs';>.
+
+=head2 Object methods and properties
+
+The object returned by the new() method can be used to invoke
+methods or retrieve properties in the same fashion as described
+in the documentation for the particular OLE class (eg. Microsoft
+Excel documentation describes the object hierarchy along with the
+properties and methods exposed for OLE access).
+
+Optional parameters on method calls can be omitted by using C<undef>
+as a placeholder. A better way is to use named arguments, as the
+order of optional parameters may change in later versions of the OLE
+server application. Named parameters can be specified in a reference
+to a hash as the last parameter to a method call.
+
+Properties can be retrieved or set using hash syntax, while methods
+can be invoked with the usual perl method call syntax. The C<keys>
+and C<each> functions can be used to enumerate an object's properties.
+Beware that a property is not always writable or even readable (sometimes
+raising exceptions when read while being undefined).
+
+If a method or property returns an embedded OLE object, method
+and property access can be chained as shown in the examples below.
+
+=head2 Functions
+
+The following functions are not exported by default.
+
+=over 8
+
+=item HRESULT(ERROR)
+
+The HRESULT() function converts an unsigned number into a signed HRESULT
+error value as used by OLE internally. This is necessary because Perl
+treats all hexadecimal constants as unsigned. To check if the last OLE
+function returned "Member not found" (0x80020003) you can write:
+
+ if (Win32::OLE->LastError == HRESULT(0x80020003)) {
+ # your error recovery here
+ }
+
+=item in(COLLECTION)
+
+If COLLECTION is an OLE collection object then C<in $COLLECTION>
+returns a list of all members of the collection. This is a shortcut
+for C<Win32::OLE::Enum-E<gt>All($COLLECTION)>. It is most commonly used in
+a C<foreach> loop:
+
+ foreach my $value (in $collection) {
+ # do something with $value here
+ }
+
+=item valof(OBJECT)
+
+Normal assignment of Perl OLE objects creates just another reference
+to the OLE object. The valof() function explictly dereferences the
+object (through the default method) and returns the value of the object.
+
+ my $RefOf = $Object;
+ my $ValOf = valof $Object;
+ $Object->{Value} = $NewValue;
+
+Now $ValOf still contains the old value whereas $RefOf would
+resolve to the $NewValue because it is still a reference to
+$Object.
+
+The valof() function can also be used to convert Win32::OLE::Variant
+objects to Perl values.
+
+=item with(OBJECT, PROPERTYNAME => VALUE, ...)
+
+This function provides a concise way to set the values of multiple
+properties of an object. It iterates over its arguments doing
+C<$OBJECT-E<gt>{PROPERTYNAME} = $VALUE> on each trailing pair.
+
+=back
+
+=head2 Overloading
+
+The Win32::OLE objects can be overloaded to automatically convert to
+their values whenever they are used in a bool, numeric or string
+context. This is not enabled by default. You have to request it
+through the OVERLOAD pseudoexport:
+
+ use Win32::OLE qw(in valof with OVERLOAD);
+
+You can still get the original string representation of an object
+(C<Win32::OLE=0xDEADBEEF>), e.g. for debugging, by using the
+C<overload::StrVal()> method:
+
+ print overload::StrVal($object), "\n";
+
+Please note that C<OVERLOAD> is a global setting. If any module enables
+Win32::OLE overloading then it's active everywhere.
+
+=head2 Events
+
+The Win32::OLE module now contains B<ALPHA> level event support. This
+support is only available when Perl is running in a single threaded
+apartment. This can most easily be assured by using the C<EVENTS>
+pseudo-import:
+
+ use Win32::OLE qw(EVENTS);
+
+which implicitly does something like:
+
+ use Win32::OLE;
+ Win32::OLE->Initialize(Win32::OLE::COINIT_OLEINITIALIZE);
+
+The current interface to OLE events should be considered experimental
+and is subject to change. It works as expected for normal OLE
+applications, but OLE control events often don't seem to work yet.
+
+Events must be enabled explicitly for an OLE object through the
+Win32::OLE->WithEvents() class method. The Win32::OLE module uses the
+IProvideClassInfo2 interface to determine the default event source of
+the object. If this interface is not supported, then the user must
+specify the name of the event source explicitly in the WithEvents()
+method call. It is also possible to specify the class name of the
+object as the third parameter. In this case Win32::OLE will try to
+look up the default source interface for this COCLASS.
+
+The HANDLER argument to Win32::OLE->WithEvents() can either be a CODE
+reference or a package name. In the first case, all events will invoke
+this particular function. The first two arguments to this function will
+be the OBJECT itself and the name of the event. The remaining arguments
+will be event specific.
+
+ sub Event {
+ my ($Obj,$Event,@Args) = @_;
+ print "Event triggered: '$Event'\n";
+ }
+ Win32::OLE->WithEvents($Obj, \&Event);
+
+Alternatively the HANDLER argument can specify a package name. When the
+OBJECT fires an event, Win32::OLE will try to find a function of the same
+name as the event in this package. This function will be called with the
+OBJECT as the first argument followed again by the event specific parameters:
+
+ package MyEvents;
+ sub EventName1 {
+ my ($Obj,@Args) = @_;
+ print "EventName1 event triggered\n";
+ }
+
+ package main;
+ Win32::OLE->WithEvents($Obj, 'MyEvents', 'IEventInterface');
+
+If Win32::OLE doesn't find a function with the name of the event then nothing
+happens.
+
+Event parameters passed I<by reference> are handled specially. They are not
+converted to the corresponding Perl datatype but passed as Win32::OLE::Variant
+objects. You can assign a new value to these objects with the help of the
+Put() method. This value will be passed back to the object when the event
+function returns:
+
+ package MyEvents;
+ sub BeforeClose {
+ my ($self,$Cancel) = @_;
+ $Cancel->Put(1) unless $MayClose;
+ }
+
+Direct assignment to $Cancel would have no effect on the original value and
+would therefore not command the object to abort the closing action.
+
+=head2 Module Options
+
+The following module options can be accessed and modified with the
+C<Win32::OLE-E<gt>Option> class method. In earlier versions of the Win32::OLE
+module these options were manipulated directly as class variables. This
+practice is now deprecated.
+
+=over 8
+
+=item CP
+
+This variable is used to determine the codepage used by all
+translations between Perl strings and Unicode strings used by the OLE
+interface. The default value is CP_ACP, which is the default ANSI
+codepage. Other possible values are CP_OEMCP, CP_MACCP, CP_UTF7 and
+CP_UTF8. These constants are not exported by default.
+
+=item LCID
+
+This variable controls the locale identifier used for all OLE calls.
+It is set to LOCALE_NEUTRAL by default. Please check the
+L<Win32::OLE::NLS> module for other locale related information.
+
+=item Variant
+
+This options controls how method calls and property accessors return
+values of type VT_CY and VT_DECIMAL are being returned. By default
+VT_CY values are turned into strings and VT_DECIMAL values into
+floating point numbers. If the C<Variant> option is enabled, these
+values are returned as Win32::OLE::Variant objects, just like VT_DATE
+and VT_ERROR values. If the Win32::OLE::Variant module is also
+loaded, then all values should still behave as before in string and in
+numeric context.
+
+The only reason that the C<Variant> behavior is not the default is that
+this is an incompatible change that might break existing programs.
+
+=item Warn
+
+This variable determines the behavior of the Win32::OLE module when
+an error happens. Valid values are:
+
+ 0 Ignore error, return undef
+ 1 Carp::carp if $^W is set (-w option)
+ 2 always Carp::carp
+ 3 Carp::croak
+
+The error number and message (without Carp line/module info) are
+available through the C<Win32::OLE-E<gt>LastError> class method.
+
+Alternatively the Warn option can be set to a CODE reference. E.g.
+
+ Win32::OLE->Option(Warn => 3);
+
+is equivalent to
+
+ Win32::OLE->Option(Warn => \&Carp::croak);
+
+This can even be used to emulate the VisualBasic C<On Error Goto
+Label> construct:
+
+ Win32::OLE->Option(Warn => sub {goto CheckError});
+ # ... your normal OLE code here ...
+
+ CheckError:
+ # ... your error handling code here ...
+
+=item _NewEnum
+
+This option enables additional enumeration support for collection
+objects. When the C<_NewEnum> option is set, all collections will
+receive one additional property: C<_NewEnum>. The value of this
+property will be a reference to an array containing all the elements
+of the collection. This option can be useful when used in conjunction
+with an automatic tree traversal program, like C<Data::Dumper> or an
+object tree browser. The value of this option should be either 1
+(enabled) or 0 (disabled, default).
+
+ Win32::OLE->Option(_NewEnum => 1);
+ # ...
+ my @sheets = @{$Excel->Worksheets->{_NewEnum}};
+
+In normal application code, this would be better written as:
+
+ use Win32::OLE qw(in);
+ # ...
+ my @sheets = in $Excel->Worksheets;
+
+=item _Unique
+
+The C<_Unique> options guarantees that Win32::OLE will maintain a
+one-to-one mapping between Win32::OLE objects and the native COM/OLE
+objects. Without this option, you can query the same property twice
+and get two different Win32::OLE objects for the same underlying COM
+object.
+
+Using a unique proxy makes life easier for tree traversal algorithms
+to recognize they already visited a particular node. This option
+comes at a price: Win32::OLE has to maintain a global hash of all
+outstanding objects and their corresponding proxies. Identity checks
+on COM objects can also be expensive if the objects reside
+out-of-process or even on a different computer. Therefore this option
+is off by default unless the program is being run in the debugger.
+
+Unfortunately, this option doesn't always help. Some programs will
+return new COM objects for even the same property when asked for it
+multiple times (especially for collections). In this case, there is
+nothing Win32::OLE can do to detect that these objects are in fact
+identical (because they aren't at the COM level).
+
+The C<_Unique> option can be set to either 1 (enabled) or 0 (disabled,
+default).
+
+=back
+
+=head1 EXAMPLES
+
+Here is a simple Microsoft Excel application.
+
+ use Win32::OLE;
+
+ # use existing instance if Excel is already running
+ eval {$ex = Win32::OLE->GetActiveObject('Excel.Application')};
+ die "Excel not installed" if $@;
+ unless (defined $ex) {
+ $ex = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;})
+ or die "Oops, cannot start Excel";
+ }
+
+ # get a new workbook
+ $book = $ex->Workbooks->Add;
+
+ # write to a particular cell
+ $sheet = $book->Worksheets(1);
+ $sheet->Cells(1,1)->{Value} = "foo";
+
+ # write a 2 rows by 3 columns range
+ $sheet->Range("A8:C9")->{Value} = [[ undef, 'Xyzzy', 'Plugh' ],
+ [ 42, 'Perl', 3.1415 ]];
+
+ # print "XyzzyPerl"
+ $array = $sheet->Range("A8:C9")->{Value};
+ for (@$array) {
+ for (@$_) {
+ print defined($_) ? "$_|" : "<undef>|";
+ }
+ print "\n";
+ }
+
+ # save and exit
+ $book->SaveAs( 'test.xls' );
+ undef $book;
+ undef $ex;
+
+Please note the destructor specified on the Win32::OLE->new method. It ensures
+that Excel will shutdown properly even if the Perl program dies. Otherwise
+there could be a process leak if your application dies after having opened
+an OLE instance of Excel. It is the responsibility of the module user to
+make sure that all OLE objects are cleaned up properly!
+
+Here is an example of using Variant data types.
+
+ use Win32::OLE;
+ use Win32::OLE::Variant;
+ $ex = Win32::OLE->new('Excel.Application', \&OleQuit) or die "oops\n";
+ $ex->{Visible} = 1;
+ $ex->Workbooks->Add;
+ # should generate a warning under -w
+ $ovR8 = Variant(VT_R8, "3 is a good number");
+ $ex->Range("A1")->{Value} = $ovR8;
+ $ex->Range("A2")->{Value} = Variant(VT_DATE, 'Jan 1,1970');
+
+ sub OleQuit {
+ my $self = shift;
+ $self->Quit;
+ }
+
+The above will put value "3" in cell A1 rather than the string
+"3 is a good number". Cell A2 will contain the date.
+
+Similarly, to invoke a method with some binary data, you can
+do the following:
+
+ $obj->Method( Variant(VT_UI1, "foo\000b\001a\002r") );
+
+Here is a wrapper class that basically delegates everything but
+new() and DESTROY(). The wrapper class shown here is another way to
+properly shut down connections if your application is liable to die
+without proper cleanup. Your own wrappers will probably do something
+more specific to the particular OLE object you may be dealing with,
+like overriding the methods that you may wish to enhance with your
+own.
+
+ package Excel;
+ use Win32::OLE;
+
+ sub new {
+ my $s = {};
+ if ($s->{Ex} = Win32::OLE->new('Excel.Application')) {
+ return bless $s, shift;
+ }
+ return undef;
+ }
+
+ sub DESTROY {
+ my $s = shift;
+ if (exists $s->{Ex}) {
+ print "# closing connection\n";
+ $s->{Ex}->Quit;
+ return undef;
+ }
+ }
+
+ sub AUTOLOAD {
+ my $s = shift;
+ $AUTOLOAD =~ s/^.*:://;
+ $s->{Ex}->$AUTOLOAD(@_);
+ }
+
+ 1;
+
+The above module can be used just like Win32::OLE, except that
+it takes care of closing connections in case of abnormal exits.
+Note that the effect of this specific example can be easier accomplished
+using the optional destructor argument of Win32::OLE::new:
+
+ my $Excel = Win32::OLE->new('Excel.Application', sub {$_[0]->Quit;});
+
+Note that the delegation shown in the earlier example is not the same as
+true subclassing with respect to further inheritance of method calls in your
+specialized object. See L<perlobj>, L<perltoot> and L<perlbot> for details.
+True subclassing (available by setting C<@ISA>) is also feasible,
+as the following example demonstrates:
+
+ #
+ # Add error reporting to Win32::OLE
+ #
+
+ package Win32::OLE::Strict;
+ use Carp;
+ use Win32::OLE;
+
+ use strict qw(vars);
+ use vars qw($AUTOLOAD @ISA);
+ @ISA = qw(Win32::OLE);
+
+ sub AUTOLOAD {
+ my $obj = shift;
+ $AUTOLOAD =~ s/^.*:://;
+ my $meth = $AUTOLOAD;
+ $AUTOLOAD = "SUPER::" . $AUTOLOAD;
+ my $retval = $obj->$AUTOLOAD(@_);
+ unless (defined($retval) || $AUTOLOAD eq 'DESTROY') {
+ my $err = Win32::OLE::LastError();
+ croak(sprintf("$meth returned OLE error 0x%08x",$err))
+ if $err;
+ }
+ return $retval;
+ }
+
+ 1;
+
+This package inherits the constructor new() from the Win32::OLE
+package. It is important to note that you cannot later rebless a
+Win32::OLE object as some information about the package is cached by
+the object. Always invoke the new() constructor through the right
+package!
+
+Here's how the above class will be used:
+
+ use Win32::OLE::Strict;
+ my $Excel = Win32::OLE::Strict->new('Excel.Application', 'Quit');
+ my $Books = $Excel->Workbooks;
+ $Books->UnknownMethod(42);
+
+In the sample above the call to UnknownMethod() will be caught with
+
+ UnknownMethod returned OLE error 0x80020009 at test.pl line 5
+
+because the Workbooks object inherits the class C<Win32::OLE::Strict> from the
+C<$Excel> object.
+
+=head1 NOTES
+
+=head2 Hints for Microsoft Office automation
+
+=over 8
+
+=item Documentation
+
+The object model for the Office applications is defined in the Visual Basic
+reference guides for the various applications. These are typically not
+installed by default during the standard installation. They can be added
+later by rerunning the setup program with the custom install option.
+
+=item Class, Method and Property names
+
+The names have been changed between different versions of Office. For
+example C<Application> was a method in Office 95 and is a property in
+Office97. Therefore it will not show up in the list of property names
+C<keys %$object> when querying an Office 95 object.
+
+The class names are not always identical to the method/property names
+producing the object. E.g. the C<Workbook> method returns an object of
+type C<Workbook> in Office 95 and C<_Workbook> in Office 97.
+
+=item Moniker (GetObject support)
+
+Office applications seem to implement file monikers only. For example
+it seems to be impossible to retrieve a specific worksheet object through
+C<GetObject("File.XLS!Sheet")>. Furthermore, in Excel 95 the moniker starts
+a Worksheet object and in Excel 97 it returns a Workbook object. You can use
+either the Win32::OLE::QueryObjectType class method or the $object->{Version}
+property to write portable code.
+
+=item Enumeration of collection objects
+
+Enumerations seem to be incompletely implemented. Office 95 application don't
+seem to support neither the Reset() nor the Clone() methods. The Clone()
+method is still unimplemented in Office 97. A single walk through the
+collection similar to Visual Basics C<for each> construct does work however.
+
+=item Localization
+
+Starting with Office 97 Microsoft has changed the localized class, method and
+property names back into English. Note that string, date and currency
+arguments are still subject to locale specific interpretation. Perl uses the
+system default locale for all OLE transaction whereas Visual Basic uses a
+type library specific locale. A Visual Basic script would use "R1C1" in string
+arguments to specify relative references. A Perl script running on a German
+language Windows would have to use "Z1S1". Set the LCID module option
+to an English locale to write portable scripts. This variable should
+not be changed after creating the OLE objects; some methods seem to randomly
+fail if the locale is changed on the fly.
+
+=item SaveAs method in Word 97 doesn't work
+
+This is an known bug in Word 97. Search the MS knowledge base for Word /
+Foxpro incompatibility. That problem applies to the Perl OLE interface as
+well. A workaround is to use the WordBasic compatibility object. It doesn't
+support all the options of the native method though.
+
+ $Word->WordBasic->FileSaveAs($file);
+
+The problem seems to be fixed by applying the Office 97 Service Release 1.
+
+=item Randomly failing method calls
+
+It seems like modifying objects that are not selected/activated is sometimes
+fragile. Most of these problems go away if the chart/sheet/document is
+selected or activated before being manipulated (just like an interactive
+user would automatically do it).
+
+=back
+
+=head2 Incompatibilities
+
+There are some incompatibilities with the version distributed by Activeware
+(as of build 306).
+
+=over 8
+
+=item 1
+
+The package name has changed from "OLE" to "Win32::OLE".
+
+=item 2
+
+All functions of the form "Win32::OLEFoo" are now "Win32::OLE::Foo",
+though the old names are temporarily accommodated. Win32::OLECreateObject()
+was changed to Win32::OLE::CreateObject(), and is now called
+Win32::OLE::new() bowing to established convention for naming constructors.
+The old names should be considered deprecated, and will be removed in the
+next version.
+
+=item 3
+
+Package "OLE::Variant" is now "Win32::OLE::Variant".
+
+=item 4
+
+The Variant function is new, and is exported by default. So are
+all the VT_XXX type constants.
+
+=item 5
+
+The support for collection objects has been moved into the package
+Win32::OLE::Enum. The C<keys %$object> method is now used to enumerate
+the properties of the object.
+
+=back
+
+=head2 Bugs and Limitations
+
+=over 8
+
+=item *
+
+To invoke a native OLE method with the same name as one of the
+Win32::OLE methods (C<Dispatch>, C<Invoke>, C<SetProperty>, C<DESTROY>,
+etc.), you have to use the C<Invoke> method:
+
+ $Object->Invoke('Dispatch', @AdditionalArgs);
+
+The same is true for names exported by the Exporter or the Dynaloader
+modules, e.g.: C<export>, C<export_to_level>, C<import>,
+C<_push_tags>, C<export_tags>, C<export_ok_tags>, C<export_fail>,
+C<require_version>, C<dl_load_flags>,
+C<croak>, C<bootstrap>, C<dl_findfile>, C<dl_expandspec>,
+C<dl_find_symbol_anywhere>, C<dl_load_file>, C<dl_find_symbol>,
+C<dl_undef_symbols>, C<dl_install_xsub> and C<dl_error>.
+
+=back
+
+=head1 SEE ALSO
+
+The documentation for L<Win32::OLE::Const>, L<Win32::OLE::Enum>,
+L<Win32::OLE::NLS> and L<Win32::OLE::Variant> contains additional
+information about OLE support for Perl on Win32.
+
+=head1 AUTHORS
+
+Originally put together by the kind people at Hip and Activeware.
+
+Gurusamy Sarathy <gsar@cpan.org> subsequently fixed several
+major bugs, memory leaks, and reliability problems, along with some
+redesign of the code.
+
+Jan Dubois <jand@activestate.com> pitched in with yet more massive redesign,
+added support for named parameters, and other significant enhancements.
+He's been hacking on it ever since.
+
+Please send questions about problems with this module to the
+Perl-Win32-Users mailinglist at ActiveState.com. The mailinglist charter
+requests that you put an [OLE] tag somewhere on the subject line (for OLE
+related questions only, of course).
+
+=head1 COPYRIGHT
+
+ (c) 1995 Microsoft Corporation. All rights reserved.
+ Developed by ActiveWare Internet Corp., now known as
+ ActiveState Tool Corp., http://www.ActiveState.com
+
+ Other modifications Copyright (c) 1997-2006 by Gurusamy Sarathy
+ <gsar@cpan.org> and Jan Dubois <jand@activestate.com>
+
+ You may distribute under the terms of either the GNU General Public
+ License or the Artistic License, as specified in the README file.
+
+=head1 VERSION
+
+Version 0.1712 14 May 2014
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm
new file mode 100644
index 0000000000..d0fe00b9ea
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Const.pm
@@ -0,0 +1,201 @@
+# The documentation is at the __END__
+
+package Win32::OLE::Const;
+
+use strict;
+use Carp;
+use Win32::OLE;
+
+my $Typelibs;
+sub _Typelib {
+ my ($clsid,$title,$version,$langid,$filename) = @_;
+ # Filenames might have a resource index appended to it.
+ $filename = $1 if $filename =~ /^(.*\.(?:dll|exe))(\\\d+)$/i;
+ # Ignore if it looks like a file but doesn't exist.
+ # We don't verify existence of monikers or filenames
+ # without a full pathname.
+ return if $filename =~ /^\w:\\.*\.(exe|dll)$/ && !-f $filename;
+ push @$Typelibs, \@_;
+}
+unless (__PACKAGE__->_Typelibs("TypeLib")) {
+ warn("Cannot access HKEY_CLASSES_ROOT\\Typelib");
+}
+# Enumerate 32bit type libraries on Win64
+__PACKAGE__->_Typelibs("Wow6432Node\\TypeLib");
+
+sub import {
+ my ($self,$name,$major,$minor,$language,$codepage) = @_;
+ return unless defined($name) && $name !~ /^\s*$/;
+ $self->Load($name,$major,$minor,$language,$codepage,scalar caller);
+}
+
+sub EnumTypeLibs {
+ my ($self,$callback) = @_;
+ foreach (@$Typelibs) { &$callback(@$_) }
+ return;
+}
+
+sub Load {
+ my ($self,$name,$major,$minor,$language,$codepage,$caller) = @_;
+
+ if (UNIVERSAL::isa($name,'Win32::OLE')) {
+ my $typelib = $name->GetTypeInfo->GetContainingTypeLib;
+ return _Constants($typelib, undef);
+ }
+
+ undef $minor unless defined $major;
+ my $typelib = $self->LoadRegTypeLib($name,$major,$minor,
+ $language,$codepage);
+ return _Constants($typelib, $caller);
+}
+
+sub LoadRegTypeLib {
+ my ($self,$name,$major,$minor,$language,$codepage) = @_;
+ undef $minor unless defined $major;
+
+ unless (defined($name) && $name !~ /^\s*$/) {
+ carp "Win32::OLE::Const->Load: No or invalid type library name";
+ return;
+ }
+
+ my @found;
+ foreach my $Typelib (@$Typelibs) {
+ my ($clsid,$title,$version,$langid,$filename) = @$Typelib;
+ next unless $title =~ /^$name/;
+ next unless $version =~ /^([0-9a-fA-F]+)\.([0-9a-fA-F]+)$/;
+ my ($maj,$min) = (hex($1), hex($2));
+ next if defined($major) && $maj != $major;
+ next if defined($minor) && $min < $minor;
+ next if defined($language) && $language != $langid;
+ push @found, [$clsid,$maj,$min,$langid,$filename];
+ }
+
+ unless (@found) {
+ carp "No type library matching \"$name\" found";
+ return;
+ }
+
+ @found = sort {
+ # Prefer greater version number
+ my $res = $b->[1] <=> $a->[1];
+ $res = $b->[2] <=> $a->[2] if $res == 0;
+ # Prefer default language for equal version numbers
+ $res = -1 if $res == 0 && $a->[3] == 0;
+ $res = 1 if $res == 0 && $b->[3] == 0;
+ $res;
+ } @found;
+
+ #printf "Loading %s\n", join(' ', @{$found[0]});
+ return _LoadRegTypeLib(@{$found[0]},$codepage);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Win32::OLE::Const - Extract constant definitions from TypeLib
+
+=head1 SYNOPSIS
+
+ use Win32::OLE::Const 'Microsoft Excel';
+ printf "xlMarkerStyleDot = %d\n", xlMarkerStyleDot;
+
+ my $wd = Win32::OLE::Const->Load("Microsoft Word 8\\.0 Object Library");
+ foreach my $key (keys %$wd) {
+ printf "$key = %s\n", $wd->{$key};
+ }
+
+=head1 DESCRIPTION
+
+This modules makes all constants from a registered OLE type library
+available to the Perl program. The constant definitions can be
+imported as functions, providing compile time name checking.
+Alternatively the constants can be returned in a hash reference
+which avoids defining lots of functions of unknown names.
+
+=head2 Functions/Methods
+
+=over 4
+
+=item use Win32::OLE::Const
+
+The C<use> statement can be used to directly import the constant names
+and values into the users namespace.
+
+ use Win32::OLE::Const (TYPELIB,MAJOR,MINOR,LANGUAGE);
+
+The TYPELIB argument specifies a regular expression for searching
+through the registry for the type library. Note that this argument is
+implicitly prefixed with C<^> to speed up matches in the most common
+cases. Use a typelib name like ".*Excel" to match anywhere within the
+description. TYPELIB is the only required argument.
+
+The MAJOR and MINOR arguments specify the requested version of
+the type specification. If the MAJOR argument is used then only
+typelibs with exactly this major version number will be matched. The
+MINOR argument however specifies the minimum acceptable minor version.
+MINOR is ignored if MAJOR is undefined.
+
+If the LANGUAGE argument is used then only typelibs with exactly this
+language id will be matched.
+
+The module will select the typelib with the highest version number
+satisfying the request. If no language id is specified then a the default
+language (0) will be preferred over the others.
+
+Note that only constants with valid Perl variable names will be exported,
+i.e. names matching this regexp: C</^[a-zA-Z_][a-zA-Z0-9_]*$/>.
+
+=item Win32::OLE::Const->Load
+
+The Win32::OLE::Const->Load method returns a reference to a hash of
+constant definitions.
+
+ my $const = Win32::OLE::Const->Load(TYPELIB,MAJOR,MINOR,LANGUAGE);
+
+The parameters are the same as for the C<use> case.
+
+This method is generally preferable when the typelib uses a non-english
+language and the constant names contain locale specific characters not
+allowed in Perl variable names.
+
+Another advantage is that all available constants can now be enumerated.
+
+The load method also accepts an OLE object as a parameter. In this case
+the OLE object is queried about its containing type library and no registry
+search is done at all. Interestingly this seems to be slower.
+
+=back
+
+=head1 EXAMPLES
+
+The first example imports all Excel constants names into the main namespace
+and prints the value of xlMarkerStyleDot (-4118).
+
+ use Win32::OLE::Const ('Microsoft Excel 8.0 Object Library');
+ print "xlMarkerStyleDot = %d\n", xlMarkerStyleDot;
+
+The second example returns all Word constants in a hash ref.
+
+ use Win32::OLE::Const;
+ my $wd = Win32::OLE::Const->Load("Microsoft Word 8.0 Object Library");
+ foreach my $key (keys %$wd) {
+ printf "$key = %s\n", $wd->{$key};
+ }
+ printf "wdGreen = %s\n", $wd->{wdGreen};
+
+The last example uses an OLE object to specify the type library:
+
+ use Win32::OLE;
+ use Win32::OLE::Const;
+ my $Excel = Win32::OLE->new('Excel.Application', 'Quit');
+ my $xl = Win32::OLE::Const->Load($Excel);
+
+
+=head1 AUTHORS/COPYRIGHT
+
+This module is part of the Win32::OLE distribution.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm
new file mode 100644
index 0000000000..6047d2c827
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Enum.pm
@@ -0,0 +1,95 @@
+# The documentation is at the __END__
+
+package Win32::OLE::Enum;
+1;
+
+# everything is pure XS in Win32::OLE::Enum
+# - new
+# - DESTROY
+#
+# - All
+# - Clone
+# - Next
+# - Reset
+# - Skip
+
+__END__
+
+=head1 NAME
+
+Win32::OLE::Enum - OLE Automation Collection Objects
+
+=head1 SYNOPSIS
+
+ my $Sheets = $Excel->Workbooks(1)->Worksheets;
+ my $Enum = Win32::OLE::Enum->new($Sheets);
+ my @Sheets = $Enum->All;
+
+ while (defined(my $Sheet = $Enum->Next)) { ... }
+
+=head1 DESCRIPTION
+
+This module provides an interface to OLE collection objects from
+Perl. It defines an enumerator object closely mirroring the
+functionality of the IEnumVARIANT interface.
+
+Please note that the Reset() method is not available in all implementations
+of OLE collections (like Excel 7). In that case the Enum object is good
+only for a single walk through of the collection.
+
+=head2 Functions/Methods
+
+=over 8
+
+=item Win32::OLE::Enum->new($object)
+
+Creates an enumerator for $object, which must be a valid OLE collection
+object. Note that correctly implemented collection objects must support
+the C<Count> and C<Item> methods, so creating an enumerator is not always
+necessary.
+
+=item $Enum->All()
+
+Returns a list of all objects in the collection. You have to call
+$Enum->Reset() before the enumerator can be used again. The previous
+position in the collection is lost.
+
+This method can also be called as a class method:
+
+ my @list = Win32::OLE::Enum->All($Collection);
+
+=item $Enum->Clone()
+
+Returns a clone of the enumerator maintaining the current position within
+the collection (if possible). Note that the C<Clone> method is often not
+implemented. Use $Enum->Clone() in an eval block to avoid dying if you
+are not sure that Clone is supported.
+
+=item $Enum->Next( [$count] )
+
+Returns the next element of the collection. In a list context the optional
+$count argument specifies the number of objects to be returned. In a scalar
+context only the last of at most $count retrieved objects is returned. The
+default for $count is 1.
+
+=item $Enum->Reset()
+
+Resets the enumeration sequence to the beginning. There is no guarantee that
+the exact same set of objects will be enumerated again (e.g. when enumerating
+files in a directory). The methods return value indicates the success of the
+operation. (Note that the Reset() method seems to be unimplemented in some
+applications like Excel 7. Use it in an eval block to avoid dying.)
+
+=item $Enum->Skip( [$count] )
+
+Skip the next $count elements of the enumeration. The default for $count is 1.
+The functions returns TRUE if at least $count elements could be skipped. It
+returns FALSE if not enough elements were left.
+
+=back
+
+=head1 AUTHORS/COPYRIGHT
+
+This module is part of the Win32::OLE distribution.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm
new file mode 100644
index 0000000000..66b5e50ac0
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Lite.pm
@@ -0,0 +1,224 @@
+package Win32::OLE;
+
+sub _croak { require Carp; Carp::croak(@_) }
+
+unless (defined &Dispatch) {
+ DynaLoader::boot_DynaLoader('DynaLoader')
+ unless defined(&DynaLoader::dl_load_file);
+ my $file;
+ foreach my $dir (@INC) {
+ my $try = "$dir/auto/Win32/OLE/OLE.dll";
+ last if $file = (-f $try && $try);
+ }
+ _croak("Can't locate loadable object for module Win32::OLE".
+ " in \@INC (\@INC contains: @INC)")
+ unless $file; # wording similar to error from 'require'
+
+ my $libref = DynaLoader::dl_load_file($file, 0) or
+ _croak("Can't load '$file' for module Win32::OLE: ".
+ DynaLoader::dl_error()."\n");
+
+ my $boot_symbol_ref = DynaLoader::dl_find_symbol($libref, "boot_Win32__OLE")
+ or _croak("Can't find 'boot_Win32__OLE' symbol in $file\n");
+
+ my $xs = DynaLoader::dl_install_xsub("Win32::OLE::bootstrap",
+ $boot_symbol_ref, $file);
+ &$xs('Win32::OLE');
+}
+
+if (defined &DB::sub && !defined $_Unique) {
+ warn "Win32::OLE operating in debugging mode: _Unique => 1\n";
+ $_Unique = 1;
+}
+
+$Warn = 1;
+
+sub CP_ACP {0;} # ANSI codepage
+sub CP_OEMCP {1;} # OEM codepage
+sub CP_MACCP {2;}
+sub CP_UTF7 {65000;}
+sub CP_UTF8 {65001;}
+
+sub DISPATCH_METHOD {1;}
+sub DISPATCH_PROPERTYGET {2;}
+sub DISPATCH_PROPERTYPUT {4;}
+sub DISPATCH_PROPERTYPUTREF {8;}
+
+sub COINIT_MULTITHREADED {0;} # Default
+sub COINIT_APARTMENTTHREADED {2;} # Use single threaded apartment model
+
+# Bogus COINIT_* values to indicate special cases:
+sub COINIT_OLEINITIALIZE {-1;} # Use OleInitialize instead of CoInitializeEx
+sub COINIT_NO_INITIALIZE {-2;} # We are already initialized, just believe me
+
+sub HRESULT {
+ my $hr = shift;
+ $hr -= 2**32 if $hr & 0x80000000;
+ return $hr;
+}
+
+# CreateObject is defined here only because it is documented in the
+# "Learning Perl on Win32 Systems" Gecko book. Please use Win32::OLE->new().
+sub CreateObject {
+ if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) {
+ $AUTOLOAD = ref($_[0]) . '::CreateObject';
+ goto &AUTOLOAD;
+ }
+
+ # Hack to allow C<$obj = CreateObject Win32::OLE 'My.App';>. Although this
+ # is contrary to the Gecko, we just make it work since it doesn't hurt.
+ return Win32::OLE->new($_[1]) if $_[0] eq 'Win32::OLE';
+
+ # Gecko form: C<$success = Win32::OLE::CreateObject('My.App',$obj);>
+ $_[1] = Win32::OLE->new($_[0]);
+ return defined $_[1];
+}
+
+sub LastError {
+ unless (defined $_[0]) {
+ # Win32::OLE::LastError() will always return $Win32::OLE::LastError
+ return $LastError;
+ }
+
+ if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) {
+ $AUTOLOAD = ref($_[0]) . '::LastError';
+ goto &AUTOLOAD;
+ }
+
+ #no strict 'refs';
+ my $LastError = "$_[0]::LastError";
+ $$LastError = $_[1] if defined $_[1];
+ return $$LastError;
+}
+
+my $Options = "^(?:CP|LCID|Warn|Variant|_NewEnum|_Unique)\$";
+
+sub Option {
+ if (ref($_[0]) && UNIVERSAL::isa($_[0],'Win32::OLE')) {
+ $AUTOLOAD = ref($_[0]) . '::Option';
+ goto &AUTOLOAD;
+ }
+
+ my $class = shift;
+
+ if (@_ == 1) {
+ my $option = shift;
+ return ${"${class}::$option"} if $option =~ /$Options/o;
+ _croak("Invalid $class option: $option");
+ }
+
+ while (@_) {
+ my ($option,$value) = splice @_, 0, 2;
+ _croak("Invalid $class option: $option") if $option !~ /$Options/o;
+ ${"${class}::$option"} = $value;
+ $class->_Unique() if $option eq "_Unique";
+ }
+}
+
+sub Invoke {
+ my ($self,$method,@args) = @_;
+ $self->Dispatch($method, my $retval, @args);
+ return $retval;
+}
+
+sub LetProperty {
+ my ($self,$method,@args) = @_;
+ $self->Dispatch([DISPATCH_PROPERTYPUT, $method], my $retval, @args);
+ return $retval;
+}
+
+sub SetProperty {
+ my ($self,$method,@args) = @_;
+ my $wFlags = DISPATCH_PROPERTYPUT;
+ if (@args) {
+ # If the value is an object then it will be set by reference!
+ my $value = $args[-1];
+ if (UNIVERSAL::isa($value, 'Win32::OLE')) {
+ $wFlags = DISPATCH_PROPERTYPUTREF;
+ }
+ elsif (UNIVERSAL::isa($value,'Win32::OLE::Variant')) {
+ my $type = $value->Type & ~0xfff; # VT_TYPEMASK
+ # VT_DISPATCH and VT_UNKNOWN represent COM objects
+ $wFlags = DISPATCH_PROPERTYPUTREF if $type == 9 || $type == 13;
+ }
+ }
+ $self->Dispatch([$wFlags, $method], my $retval, @args);
+ return $retval;
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $autoload = substr $AUTOLOAD, rindex($AUTOLOAD, ':')+1;
+ _croak("Cannot autoload class method \"$autoload\"")
+ unless ref($self) && UNIVERSAL::isa($self, 'Win32::OLE');
+ my $success = $self->Dispatch($autoload, my $retval, @_);
+ unless (defined $success || ($^H & 0x200) != 0) {
+ # Retry default method if C<no strict 'subs';>
+ $self->Dispatch(undef, $retval, $autoload, @_);
+ }
+ return $retval;
+}
+
+sub in {
+ my @res;
+ while (@_) {
+ my $this = shift;
+ if (UNIVERSAL::isa($this, 'Win32::OLE')) {
+ push @res, Win32::OLE::Enum->All($this);
+ }
+ elsif (ref($this) eq 'ARRAY') {
+ push @res, @$this;
+ }
+ else {
+ push @res, $this;
+ }
+ }
+ return @res;
+}
+
+sub valof {
+ my $arg = shift;
+ if (UNIVERSAL::isa($arg, 'Win32::OLE')) {
+ require Win32::OLE::Variant;
+ my ($class) = overload::StrVal($arg) =~ /^([^=]+)=/;
+ #no strict 'refs';
+ local $Win32::OLE::CP = ${"${class}::CP"};
+ local $Win32::OLE::LCID = ${"${class}::LCID"};
+ #use strict 'refs';
+ # VT_EMPTY variant for return code
+ my $variant = Win32::OLE::Variant->new;
+ $arg->Dispatch(undef, $variant);
+ return $variant->Value;
+ }
+ $arg = $arg->Value if UNIVERSAL::can($arg, 'Value');
+ return $arg;
+}
+
+sub with {
+ my $object = shift;
+ while (@_) {
+ my $property = shift;
+ $object->{$property} = shift;
+ }
+}
+
+########################################################################
+
+package Win32::OLE::Tie;
+
+# Only retry default method under C<no strict 'subs';>
+sub FETCH {
+ my ($self,$key) = @_;
+ if ($key eq "_NewEnum") {
+ (my $class = ref $self) =~ s/::Tie$//;
+ return [Win32::OLE::Enum->All($self)] if ${"${class}::_NewEnum"};
+ }
+ $self->Fetch($key, !$Win32::OLE::Strict);
+}
+
+sub STORE {
+ my ($self,$key,$value) = @_;
+ $self->Store($key, $value, !$Win32::OLE::Strict);
+}
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod
new file mode 100644
index 0000000000..217fe4a6fc
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/NEWS.pod
@@ -0,0 +1,380 @@
+=pod
+
+=head1 NAME
+
+Win32::OLE::NEWS - What's new in Win32::OLE
+
+This file contains a history of user visible changes to the
+Win32::OLE::* modules. Only new features and major bug fixes that
+might affect backwards compatibility are included.
+
+=head1 Version 0.18
+
+=head2 VT_CY and VT_DECIMAL return values handled differently
+
+The new C<Variant> option enables values of VT_CY or VT_DECIMAL type
+to be returned as Win32::OLE::Variant objects instead of being
+converted into strings and numbers respectively. This is similar to
+the change in Win32::OLE version 0.12 to VT_DATE and VT_ERROR values.
+The Win32::OLE::Variant module must be included to make sure that
+VT_CY and VT_DECIMAL values behave as before in numeric or string
+contexts.
+
+Because the new behavior is potentially incompatible, it must be
+explicitly enabled:
+
+ Win32::OLE->Option(Variant => 1);
+
+
+=head1 Version 0.17
+
+=head2 New nullstring() function in Win32::OLE::Variant
+
+The nullstring() function returns a VT_BSTR variant containing a NULL
+string pointer. Note that this is not the same as a VT_BSTR variant
+containing the empty string "".
+
+The nullstring() return value is equivalent to the Visual Basic
+C<vbNullString> constant.
+
+
+=head1 Version 0.16
+
+=head2 Improved Unicode support
+
+Passing Unicode strings to methods and properties as well as returning
+Unicode strings back to Perl works now with both Perl 5.6 and 5.8.
+Note that the Unicode support in 5.8 is much more complete than in 5.6
+or 5.6.1.
+
+C<Unicode::String> objects can now be passed to methods or assigned to
+properties.
+
+You must enable Unicode support by switching Win32::OLE to the UTF8
+codepage:
+
+ Win32::OLE->Option(CP => Win32::OLE::CP_UTF8());
+
+
+=head1 Version 0.13
+
+=head2 New nothing() function in Win32::OLE::Variant
+
+The nothing() function returns an empty VT_DISPATCH variant. It can be
+used to clear an object reference stored in a property
+
+ use Win32::OLE::Variant qw(:DEFAULT nothing);
+ # ...
+ $object->{Property} = nothing;
+
+This has the same effect as the Visual Basic statement
+
+ Set object.Property = Nothing
+
+=head2 New _NewEnum and _Unique options
+
+There are two new options available for the Win32::OLE->Option class
+method: C<_NewEnum> provides the elements of a collection object
+directly as the value of a C<_NewEnum> property. The C<_Unique>
+option guarantees that Win32::OLE will not create multiple proxy
+objects for the same underlying COM/OLE object.
+
+Both options are only really useful to tree traversal programs or
+during debugging.
+
+
+=head1 Version 0.12
+
+=head2 Additional error handling functionality
+
+The Warn option can now be set to a CODE reference too. For example,
+
+ Win32::OLE->Option(Warn => 3);
+
+could now be written as
+
+ Win32::OLE->Option(Warn => \&Carp::croak);
+
+This can even be used to emulate the VisualBasic C<On Error Goto
+Label> construct:
+
+ Win32::OLE->Option(Warn => sub {goto CheckError});
+ # ... your normal OLE code here ...
+
+ CheckError:
+ # ... your error handling code here ...
+
+=head2 Builtin event loop
+
+Processing OLE events required a polling loop before, e.g.
+
+ my $Quit;
+ #...
+ until ($Quit) {
+ Win32::OLE->SpinMessageLoop;
+ Win32::Sleep(100);
+ }
+ package BrowserEvents;
+ sub OnQuit { $Quit = 1 }
+
+This is inefficient and a bit odd. This version of Win32::OLE now
+supports a standard messageloop:
+
+ Win32::OLE->MessageLoop();
+
+ package BrowserEvents;
+ sub OnQuit { Win32::OLE->QuitMessageLoop }
+
+=head2 Free unused OLE libraries
+
+Previous versions of Win32::OLE would call the CoFreeUnusedLibraries()
+API whenever an OLE object was destroyed. This made sure that OLE
+libraries would be unloaded as soon as they were no longer needed.
+Unfortunately, objects implemented in Visual Basic tend to crash
+during this call, as they pretend to be ready for unloading, when in
+fact, they aren't.
+
+The unloading of object libraries is really only important for long
+running processes that might instantiate a huge number of B<different>
+objects over time. Therefore this API is no longer called
+automatically. The functionality is now available explicitly to those
+who want or need it by calling a Win32::OLE class method:
+
+ Win32::OLE->FreeUnusedLibraries();
+
+=head2 The "Win32::OLE" article from "The Perl Journal #10"
+
+The article is Copyright 1998 by I<The Perl
+Journal>. http://www.tpj.com
+
+It originally appeared in I<The Perl Journal> # 10 and appears here
+courtesy of Jon Orwant and I<The Perl Journal>. The sample code from
+the article is in the F<eg/tpj.pl> file.
+
+=head2 VARIANT->Put() bug fixes
+
+The Put() method didn't work correctly for arrays of type VT_BSTR,
+VT_DISPATH or VT_UNKNOWN. This has been fixed.
+
+=head2 Error message fixes
+
+Previous versions of Win32::OLE gave a wrong argument index for some
+OLE error messages (the number was too large by 1). This should be
+fixed now.
+
+=head2 VT_DATE and VT_ERROR return values handled differently
+
+Method calls and property accesses returning a VT_DATE or VT_ERROR
+value would previously translate the value to string or integer
+format. This has been changed to return a Win32::OLE::Variant object.
+The return values will behave as before if the Win32::OLE::Variant
+module is being used. This module overloads the conversion of
+the objects to strings and numbers.
+
+
+=head1 Version 0.11 (changes since 0.1008)
+
+=head2 new DHTML typelib browser
+
+The Win32::OLE distribution now contains a type library browser. It
+is written in PerlScript, generating dynamic HTML. It requires
+Internet Explorer 4.0 or later. You'll find it in
+F<browser/Browser.html>. It should be available in the ActivePerl
+HTML help under Win32::OLE::Browser.
+
+After selecting a library, type or member you can press F1 to call up
+the corresponding help file at the appropriate location.
+
+=head2 VT_DECIMAL support
+
+The Win32::OLE::Variant module now supports VT_DECIMAL variants too.
+They are not "officially" allowed in OLE Automation calls, but even
+Microsoft's "ActiveX Data Objects" sometimes returns VT_DECIMAL
+values.
+
+VT_DECIMAL variables are stored as 96-bit integers scaled by a
+variable power of 10. The power of 10 scaling factor specifies the
+number of digits to the right of the decimal point, and ranges from 0
+to 28. With a scale of 0 (no decimal places), the largest possible
+value is +/-79,228,162,514,264,337,593,543,950,335. With a 28 decimal
+places, the largest value is +/-7.9228162514264337593543950335 and the
+smallest, non-zero value is +/-0.0000000000000000000000000001.
+
+=head1 Version 0.1008
+
+=head2 new LetProperty() object method
+
+In Win32::OLE property assignment using the hash syntax is equivalent
+to the Visual Basic C<Set> syntax (I<by reference> assignment):
+
+ $Object->{Property} = $OtherObject;
+
+corresponds to this Visual Basic statement:
+
+ Set Object.Property = OtherObject
+
+To get the I<by value> treatment of the Visual Basic C<Let> statement
+
+ Object.Property = OtherObject
+
+you have to use the LetProperty() object method in Perl:
+
+ $Object->LetProperty($Property, $OtherObject);
+
+=head2 new HRESULT() function
+
+The HRESULT() function converts an unsigned number into a signed HRESULT
+error value as used by OLE internally. This is necessary because Perl
+treats all hexadecimal constants as unsigned. To check if the last OLE
+function returned "Member not found" (0x80020003) you can write:
+
+ if (Win32::OLE->LastError == HRESULT(0x80020003)) {
+ # your error recovery here
+ }
+
+=head1 Version 0.1007 (changes since 0.1005)
+
+=head2 OLE Event support
+
+This version of Win32::OLE contains B<ALPHA> level support for OLE events. The
+user interface is still subject to change. There are ActiveX objects / controls
+that don't fire events under the current implementation.
+
+Events are enabled for a specific object with the Win32::OLE->WithEvents()
+class method:
+
+ Win32::OLE->WithEvents(OBJECT, HANDLER, INTERFACE)
+
+Please read further documentation in Win32::OLE.
+
+=head2 GetObject() and GetActiveObject() now support optional DESTRUCTOR argument
+
+It is now possible to specify a DESTRUCTOR argument to the GetObject() and
+GetActiveObject() class methods. They work identical to the new() DESTRUCTOR
+argument.
+
+=head2 Remote object instantiation via DCOM
+
+This has actually been in Win32::OLE since 0.0608, but somehow never got
+documented. You can provide an array reference in place of the usual PROGID
+parameter to Win32::OLE->new():
+
+ OBJ = Win32::OLE->new([MACHINE, PRODID]);
+
+The array must contain two elements: the name of the MACHINE and the PROGID.
+This will try to create the object on the remote MACHINE.
+
+=head2 Enumerate all Win32::OLE objects
+
+This class method returns the number Win32::OLE objects currently in
+existence. It will call the optional CALLBACK function for each of
+these objects:
+
+ $Count = Win32::OLE->EnumAllObjects(sub {
+ my $Object = shift;
+ my $Class = Win32::OLE->QueryObjectType($Object);
+ printf "# Object=%s Class=%s\n", $Object, $Class;
+ });
+
+The EnumAllObjects() method is primarily a debugging tool. It can be
+used e.g. in an END block to check if all external connections have
+been properly destroyed.
+
+=head2 The VARIANT->Put() method now returns the VARIANT object itself
+
+This allows chaining of Put() method calls to set multiple values in an
+array variant:
+
+ $Array->Put(0,0,$First_value)->Put(0,1,$Another_value);
+
+=head2 The VARIANT->Put(ARRAYREF) form allows assignment to a complete SAFEARRAY
+
+This allows automatic conversion from a list of lists to a SAFEARRAY.
+You can now write:
+
+ my $Array = Variant(VT_ARRAY|VT_R8, [1,2], 2);
+ $Array->Put([[1,2], [3,4]]);
+
+instead of the tedious:
+
+ $Array->Put(1,0,1);
+ $Array->Put(1,1,2);
+ $Array->Put(2,0,3);
+ $Array->Put(2,1,4);
+
+=head2 New Variant formatting methods
+
+There are four new methods for formatting variant values: Currency(), Date(),
+Number() and Time(). For example:
+
+ my $v = Variant(VT_DATE, "April 1 99");
+ print $v->Date(DATE_LONGDATE), "\n";
+ print $v->Date("ddd',' MMM dd yy"), "\n";
+
+will print:
+
+ Thursday, April 01, 1999
+ Thu, Apr 01 99
+
+=head2 new Win32::OLE::NLS methods: SendSettingChange() and SetLocaleInfo()
+
+SendSettingChange() sends a WM_SETTINGCHANGE message to all top level windows.
+
+SetLocaleInfo() allows changing elements in the user override section of the
+locale database. Unfortunately these changes are not automatically available
+to further Variant formatting; you have to call SendSettingChange() first.
+
+=head2 Win32::OLE::Const now correctly treats version numbers as hex
+
+The minor and major version numbers of type libraries have been treated as
+decimal. This was wrong. They are now correctly decoded as hex.
+
+=head2 more robust global destruction of Win32::OLE objects
+
+The final destruction of Win32::OLE objects has always been somewhat fragile.
+The reason for this is that Perl doesn't honour reference counts during global
+destruction but destroys objects in seemingly random order. This can lead
+to leaked database connections or unterminated external objects. The only
+solution was to make all objects lexical and hope that no object would be
+trapped in a closure. Alternatively all objects could be explicitly set to
+C<undef>, which doesn't work very well with exception handling.
+
+With version 0.1007 of Win32::OLE this problem should be gone: The module
+keeps a list of active Win32::OLE objects. It uses an END block to destroy
+all objects at program termination I<before> the Perl's global destruction
+starts. Objects still existing at program termination are now destroyed in
+reverse order of creation. The effect is similar to explicitly calling
+Win32::OLE->Uninitialize() just prior to termination.
+
+=head1 Version 0.1005 (changes since 0.1003)
+
+Win32::OLE 0.1005 has been release with ActivePerl build 509. It is also
+included in the I<Perl Resource Kit for Win32> Update.
+
+=head2 optional DESTRUCTOR for GetActiveObject() GetObject() class methods
+
+The GetActiveObject() and GetObject() class method now also support an
+optional DESTRUCTOR parameter just like Win32::OLE->new(). The DESTRUCTOR
+is executed when the last reference to this object goes away. It is
+generally considered C<impolite> to stop applications that you did not
+start yourself.
+
+=head2 new Variant object method: $object->Copy()
+
+See L<Win32::OLE::Variant/Copy([DIM])>.
+
+=head2 new Win32::OLE->Option() class method
+
+The Option() class method can be used to inspect and modify
+L<Win32::OLE/Module Options>. The single argument form retrieves
+the value of an option:
+
+ my $CP = Win32::OLE->Option('CP');
+
+A single call can be used to set multiple options simultaneously:
+
+ Win32::OLE->Option(CP => CP_ACP, Warn => 3);
+
+Currently the following options exist: CP, LCID and C<Warn>.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm
new file mode 100644
index 0000000000..84ea0c7724
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/NLS.pm
@@ -0,0 +1,968 @@
+# The documentation is at the __END__
+
+package Win32::OLE::NLS;
+require Win32::OLE; # Make sure the XS bootstrap has been called
+
+use strict;
+use vars qw(@EXPORT @EXPORT_OK %EXPORT_TAGS @ISA);
+
+use Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(
+ CompareString
+ LCMapString
+ GetLocaleInfo
+ GetStringType
+ GetSystemDefaultLangID
+ GetSystemDefaultLCID
+ GetUserDefaultLangID
+ GetUserDefaultLCID
+
+ MAKELANGID
+ PRIMARYLANGID
+ SUBLANGID
+ LANG_SYSTEM_DEFAULT
+ LANG_USER_DEFAULT
+ MAKELCID
+ LANGIDFROMLCID
+ LOCALE_SYSTEM_DEFAULT
+ LOCALE_USER_DEFAULT
+ );
+
+@EXPORT_OK = qw(SetLocaleInfo SendSettingChange);
+
+%EXPORT_TAGS =
+(
+ CT => [qw(CT_CTYPE1 CT_CTYPE2 CT_CTYPE3)],
+ C1 => [qw(C1_UPPER C1_LOWER C1_DIGIT C1_SPACE C1_PUNCT
+ C1_CNTRL C1_BLANK C1_XDIGIT C1_ALPHA)],
+ C2 => [qw(C2_LEFTTORIGHT C2_RIGHTTOLEFT C2_EUROPENUMBER
+ C2_EUROPESEPARATOR C2_EUROPETERMINATOR C2_ARABICNUMBER
+ C2_COMMONSEPARATOR C2_BLOCKSEPARATOR C2_SEGMENTSEPARATOR
+ C2_WHITESPACE C2_OTHERNEUTRAL C2_NOTAPPLICABLE)],
+ C3 => [qw(C3_NONSPACING C3_DIACRITIC C3_VOWELMARK C3_SYMBOL C3_KATAKANA
+ C3_HIRAGANA C3_HALFWIDTH C3_FULLWIDTH C3_IDEOGRAPH C3_KASHIDA
+ C3_ALPHA C3_NOTAPPLICABLE)],
+ NORM => [qw(NORM_IGNORECASE NORM_IGNORENONSPACE NORM_IGNORESYMBOLS
+ NORM_IGNOREWIDTH NORM_IGNOREKANATYPE NORM_IGNOREKASHIDA)],
+ LCMAP => [qw(LCMAP_LOWERCASE LCMAP_UPPERCASE LCMAP_SORTKEY LCMAP_HALFWIDTH
+ LCMAP_FULLWIDTH LCMAP_HIRAGANA LCMAP_KATAKANA)],
+ LANG => [qw(LANG_NEUTRAL LANG_ALBANIAN LANG_ARABIC LANG_BAHASA
+ LANG_BULGARIAN LANG_CATALAN LANG_CHINESE LANG_CZECH LANG_DANISH
+ LANG_DUTCH LANG_ENGLISH LANG_FINNISH LANG_FRENCH LANG_GERMAN
+ LANG_GREEK LANG_HEBREW LANG_HUNGARIAN LANG_ICELANDIC
+ LANG_ITALIAN LANG_JAPANESE LANG_KOREAN LANG_NORWEGIAN
+ LANG_POLISH LANG_PORTUGUESE LANG_RHAETO_ROMAN LANG_ROMANIAN
+ LANG_RUSSIAN LANG_SERBO_CROATIAN LANG_SLOVAK LANG_SPANISH
+ LANG_SWEDISH LANG_THAI LANG_TURKISH LANG_URDU)],
+ SUBLANG => [qw(SUBLANG_NEUTRAL SUBLANG_DEFAULT SUBLANG_SYS_DEFAULT
+ SUBLANG_CHINESE_SIMPLIFIED SUBLANG_CHINESE_TRADITIONAL
+ SUBLANG_DUTCH SUBLANG_DUTCH_BELGIAN SUBLANG_ENGLISH_US
+ SUBLANG_ENGLISH_UK SUBLANG_ENGLISH_AUS SUBLANG_ENGLISH_CAN
+ SUBLANG_ENGLISH_NZ SUBLANG_ENGLISH_EIRE SUBLANG_FRENCH
+ SUBLANG_FRENCH_BELGIAN SUBLANG_FRENCH_CANADIAN
+ SUBLANG_FRENCH_SWISS SUBLANG_GERMAN SUBLANG_GERMAN_SWISS
+ SUBLANG_GERMAN_AUSTRIAN SUBLANG_ITALIAN SUBLANG_ITALIAN_SWISS
+ SUBLANG_NORWEGIAN_BOKMAL SUBLANG_NORWEGIAN_NYNORSK
+ SUBLANG_PORTUGUESE SUBLANG_PORTUGUESE_BRAZILIAN
+ SUBLANG_SERBO_CROATIAN_CYRILLIC SUBLANG_SERBO_CROATIAN_LATIN
+ SUBLANG_SPANISH SUBLANG_SPANISH_MEXICAN
+ SUBLANG_SPANISH_MODERN)],
+ CTRY => [qw(CTRY_DEFAULT CTRY_AUSTRALIA CTRY_AUSTRIA CTRY_BELGIUM
+ CTRY_BRAZIL CTRY_CANADA CTRY_DENMARK CTRY_FINLAND CTRY_FRANCE
+ CTRY_GERMANY CTRY_ICELAND CTRY_IRELAND CTRY_ITALY CTRY_JAPAN
+ CTRY_MEXICO CTRY_NETHERLANDS CTRY_NEW_ZEALAND CTRY_NORWAY
+ CTRY_PORTUGAL CTRY_PRCHINA CTRY_SOUTH_KOREA CTRY_SPAIN
+ CTRY_SWEDEN CTRY_SWITZERLAND CTRY_TAIWAN CTRY_UNITED_KINGDOM
+ CTRY_UNITED_STATES)],
+ LOCALE => [qw(LOCALE_NOUSEROVERRIDE LOCALE_ILANGUAGE LOCALE_SLANGUAGE
+ LOCALE_SENGLANGUAGE LOCALE_SABBREVLANGNAME
+ LOCALE_SNATIVELANGNAME LOCALE_ICOUNTRY LOCALE_SCOUNTRY
+ LOCALE_SENGCOUNTRY LOCALE_SABBREVCTRYNAME LOCALE_SNATIVECTRYNAME
+ LOCALE_IDEFAULTLANGUAGE LOCALE_IDEFAULTCOUNTRY
+ LOCALE_IDEFAULTCODEPAGE LOCALE_IDEFAULTANSICODEPAGE LOCALE_SLIST
+ LOCALE_IMEASURE LOCALE_SDECIMAL LOCALE_STHOUSAND
+ LOCALE_SGROUPING LOCALE_IDIGITS LOCALE_ILZERO LOCALE_INEGNUMBER
+ LOCALE_SNATIVEDIGITS LOCALE_SCURRENCY LOCALE_SINTLSYMBOL
+ LOCALE_SMONDECIMALSEP LOCALE_SMONTHOUSANDSEP LOCALE_SMONGROUPING
+ LOCALE_ICURRDIGITS LOCALE_IINTLCURRDIGITS LOCALE_ICURRENCY
+ LOCALE_INEGCURR LOCALE_SDATE LOCALE_STIME LOCALE_SSHORTDATE
+ LOCALE_SLONGDATE LOCALE_STIMEFORMAT LOCALE_IDATE LOCALE_ILDATE
+ LOCALE_ITIME LOCALE_ITIMEMARKPOSN LOCALE_ICENTURY LOCALE_ITLZERO
+ LOCALE_IDAYLZERO LOCALE_IMONLZERO LOCALE_S1159 LOCALE_S2359
+ LOCALE_ICALENDARTYPE LOCALE_IOPTIONALCALENDAR
+ LOCALE_IFIRSTDAYOFWEEK LOCALE_IFIRSTWEEKOFYEAR LOCALE_SDAYNAME1
+ LOCALE_SDAYNAME2 LOCALE_SDAYNAME3 LOCALE_SDAYNAME4
+ LOCALE_SDAYNAME5 LOCALE_SDAYNAME6 LOCALE_SDAYNAME7
+ LOCALE_SABBREVDAYNAME1 LOCALE_SABBREVDAYNAME2
+ LOCALE_SABBREVDAYNAME3 LOCALE_SABBREVDAYNAME4
+ LOCALE_SABBREVDAYNAME5 LOCALE_SABBREVDAYNAME6
+ LOCALE_SABBREVDAYNAME7 LOCALE_SMONTHNAME1 LOCALE_SMONTHNAME2
+ LOCALE_SMONTHNAME3 LOCALE_SMONTHNAME4 LOCALE_SMONTHNAME5
+ LOCALE_SMONTHNAME6 LOCALE_SMONTHNAME7 LOCALE_SMONTHNAME8
+ LOCALE_SMONTHNAME9 LOCALE_SMONTHNAME10 LOCALE_SMONTHNAME11
+ LOCALE_SMONTHNAME12 LOCALE_SMONTHNAME13 LOCALE_SABBREVMONTHNAME1
+ LOCALE_SABBREVMONTHNAME2 LOCALE_SABBREVMONTHNAME3
+ LOCALE_SABBREVMONTHNAME4 LOCALE_SABBREVMONTHNAME5
+ LOCALE_SABBREVMONTHNAME6 LOCALE_SABBREVMONTHNAME7
+ LOCALE_SABBREVMONTHNAME8 LOCALE_SABBREVMONTHNAME9
+ LOCALE_SABBREVMONTHNAME10 LOCALE_SABBREVMONTHNAME11
+ LOCALE_SABBREVMONTHNAME12 LOCALE_SABBREVMONTHNAME13
+ LOCALE_SPOSITIVESIGN LOCALE_SNEGATIVESIGN LOCALE_IPOSSIGNPOSN
+ LOCALE_INEGSIGNPOSN LOCALE_IPOSSYMPRECEDES LOCALE_IPOSSEPBYSPACE
+ LOCALE_INEGSYMPRECEDES LOCALE_INEGSEPBYSPACE)],
+ TIME => [qw(TIME_NOMINUTESORSECONDS TIME_NOSECONDS TIME_NOTIMEMARKER
+ TIME_FORCE24HOURFORMAT)],
+ DATE => [qw(DATE_SHORTDATE DATE_LONGDATE DATE_USE_ALT_CALENDAR
+ DATE_YEARMONTH DATE_LTRREADING DATE_RTLREADING)],
+);
+
+foreach my $tag (keys %EXPORT_TAGS) {
+ push @EXPORT_OK, @{$EXPORT_TAGS{$tag}};
+}
+
+# Character Type Flags
+sub CT_CTYPE1 { 0x0001 }
+sub CT_CTYPE2 { 0x0002 }
+sub CT_CTYPE3 { 0x0004 }
+
+# Character Type 1 Bits
+sub C1_UPPER { 0x0001 }
+sub C1_LOWER { 0x0002 }
+sub C1_DIGIT { 0x0004 }
+sub C1_SPACE { 0x0008 }
+sub C1_PUNCT { 0x0010 }
+sub C1_CNTRL { 0x0020 }
+sub C1_BLANK { 0x0040 }
+sub C1_XDIGIT { 0x0080 }
+sub C1_ALPHA { 0x0100 }
+
+# Character Type 2 Bits
+sub C2_LEFTTORIGHT { 0x1 }
+sub C2_RIGHTTOLEFT { 0x2 }
+sub C2_EUROPENUMBER { 0x3 }
+sub C2_EUROPESEPARATOR { 0x4 }
+sub C2_EUROPETERMINATOR { 0x5 }
+sub C2_ARABICNUMBER { 0x6 }
+sub C2_COMMONSEPARATOR { 0x7 }
+sub C2_BLOCKSEPARATOR { 0x8 }
+sub C2_SEGMENTSEPARATOR { 0x9 }
+sub C2_WHITESPACE { 0xA }
+sub C2_OTHERNEUTRAL { 0xB }
+sub C2_NOTAPPLICABLE { 0x0 }
+
+# Character Type 3 Bits
+sub C3_NONSPACING { 0x0001 }
+sub C3_DIACRITIC { 0x0002 }
+sub C3_VOWELMARK { 0x0004 }
+sub C3_SYMBOL { 0x0008 }
+sub C3_KATAKANA { 0x0010 }
+sub C3_HIRAGANA { 0x0020 }
+sub C3_HALFWIDTH { 0x0040 }
+sub C3_FULLWIDTH { 0x0080 }
+sub C3_IDEOGRAPH { 0x0100 }
+sub C3_KASHIDA { 0x0200 }
+sub C3_ALPHA { 0x8000 }
+sub C3_NOTAPPLICABLE { 0x0 }
+
+# String Flags
+sub NORM_IGNORECASE { 0x0001 }
+sub NORM_IGNORENONSPACE { 0x0002 }
+sub NORM_IGNORESYMBOLS { 0x0004 }
+sub NORM_IGNOREWIDTH { 0x0008 }
+sub NORM_IGNOREKANATYPE { 0x0040 }
+sub NORM_IGNOREKASHIDA { 0x40000}
+
+# Locale Dependent Mapping Flags
+sub LCMAP_LOWERCASE { 0x0100 }
+sub LCMAP_UPPERCASE { 0x0200 }
+sub LCMAP_SORTKEY { 0x0400 }
+sub LCMAP_HALFWIDTH { 0x0800 }
+sub LCMAP_FULLWIDTH { 0x1000 }
+sub LCMAP_HIRAGANA { 0x2000 }
+sub LCMAP_KATAKANA { 0x4000 }
+
+# Primary Language Identifier
+sub LANG_NEUTRAL { 0x00 }
+sub LANG_ALBANIAN { 0x1c }
+sub LANG_ARABIC { 0x01 }
+sub LANG_BAHASA { 0x21 }
+sub LANG_BULGARIAN { 0x02 }
+sub LANG_CATALAN { 0x03 }
+sub LANG_CHINESE { 0x04 }
+sub LANG_CZECH { 0x05 }
+sub LANG_DANISH { 0x06 }
+sub LANG_DUTCH { 0x13 }
+sub LANG_ENGLISH { 0x09 }
+sub LANG_FINNISH { 0x0b }
+sub LANG_FRENCH { 0x0c }
+sub LANG_GERMAN { 0x07 }
+sub LANG_GREEK { 0x08 }
+sub LANG_HEBREW { 0x0d }
+sub LANG_HUNGARIAN { 0x0e }
+sub LANG_ICELANDIC { 0x0f }
+sub LANG_ITALIAN { 0x10 }
+sub LANG_JAPANESE { 0x11 }
+sub LANG_KOREAN { 0x12 }
+sub LANG_NORWEGIAN { 0x14 }
+sub LANG_POLISH { 0x15 }
+sub LANG_PORTUGUESE { 0x16 }
+sub LANG_RHAETO_ROMAN { 0x17 }
+sub LANG_ROMANIAN { 0x18 }
+sub LANG_RUSSIAN { 0x19 }
+sub LANG_SERBO_CROATIAN { 0x1a }
+sub LANG_SLOVAK { 0x1b }
+sub LANG_SPANISH { 0x0a }
+sub LANG_SWEDISH { 0x1d }
+sub LANG_THAI { 0x1e }
+sub LANG_TURKISH { 0x1f }
+sub LANG_URDU { 0x20 }
+
+# Sublanguage Identifier
+sub SUBLANG_NEUTRAL { 0x00 }
+sub SUBLANG_DEFAULT { 0x01 }
+sub SUBLANG_SYS_DEFAULT { 0x02 }
+sub SUBLANG_CHINESE_SIMPLIFIED { 0x02 }
+sub SUBLANG_CHINESE_TRADITIONAL { 0x01 }
+sub SUBLANG_DUTCH { 0x01 }
+sub SUBLANG_DUTCH_BELGIAN { 0x02 }
+sub SUBLANG_ENGLISH_US { 0x01 }
+sub SUBLANG_ENGLISH_UK { 0x02 }
+sub SUBLANG_ENGLISH_AUS { 0x03 }
+sub SUBLANG_ENGLISH_CAN { 0x04 }
+sub SUBLANG_ENGLISH_NZ { 0x05 }
+sub SUBLANG_ENGLISH_EIRE { 0x06 }
+sub SUBLANG_FRENCH { 0x01 }
+sub SUBLANG_FRENCH_BELGIAN { 0x02 }
+sub SUBLANG_FRENCH_CANADIAN { 0x03 }
+sub SUBLANG_FRENCH_SWISS { 0x04 }
+sub SUBLANG_GERMAN { 0x01 }
+sub SUBLANG_GERMAN_SWISS { 0x02 }
+sub SUBLANG_GERMAN_AUSTRIAN { 0x03 }
+sub SUBLANG_ITALIAN { 0x01 }
+sub SUBLANG_ITALIAN_SWISS { 0x02 }
+sub SUBLANG_NORWEGIAN_BOKMAL { 0x01 }
+sub SUBLANG_NORWEGIAN_NYNORSK { 0x02 }
+sub SUBLANG_PORTUGUESE { 0x02 }
+sub SUBLANG_PORTUGUESE_BRAZILIAN { 0x01 }
+sub SUBLANG_SERBO_CROATIAN_CYRILLIC { 0x02 }
+sub SUBLANG_SERBO_CROATIAN_LATIN { 0x01 }
+sub SUBLANG_SPANISH { 0x01 }
+sub SUBLANG_SPANISH_MEXICAN { 0x02 }
+sub SUBLANG_SPANISH_MODERN { 0x03 }
+
+# Country codes
+sub CTRY_DEFAULT { 0 }
+sub CTRY_AUSTRALIA { 61 }
+sub CTRY_AUSTRIA { 43 }
+sub CTRY_BELGIUM { 32 }
+sub CTRY_BRAZIL { 55 }
+sub CTRY_CANADA { 2 }
+sub CTRY_DENMARK { 45 }
+sub CTRY_FINLAND { 358 }
+sub CTRY_FRANCE { 33 }
+sub CTRY_GERMANY { 49 }
+sub CTRY_ICELAND { 354 }
+sub CTRY_IRELAND { 353 }
+sub CTRY_ITALY { 39 }
+sub CTRY_JAPAN { 81 }
+sub CTRY_MEXICO { 52 }
+sub CTRY_NETHERLANDS { 31 }
+sub CTRY_NEW_ZEALAND { 64 }
+sub CTRY_NORWAY { 47 }
+sub CTRY_PORTUGAL { 351 }
+sub CTRY_PRCHINA { 86 }
+sub CTRY_SOUTH_KOREA { 82 }
+sub CTRY_SPAIN { 34 }
+sub CTRY_SWEDEN { 46 }
+sub CTRY_SWITZERLAND { 41 }
+sub CTRY_TAIWAN { 886 }
+sub CTRY_UNITED_KINGDOM { 44 }
+sub CTRY_UNITED_STATES { 1 }
+
+# Locale Types
+sub LOCALE_NOUSEROVERRIDE { 0x80000000 }
+sub LOCALE_ILANGUAGE { 0x0001 }
+sub LOCALE_SLANGUAGE { 0x0002 }
+sub LOCALE_SENGLANGUAGE { 0x1001 }
+sub LOCALE_SABBREVLANGNAME { 0x0003 }
+sub LOCALE_SNATIVELANGNAME { 0x0004 }
+sub LOCALE_ICOUNTRY { 0x0005 }
+sub LOCALE_SCOUNTRY { 0x0006 }
+sub LOCALE_SENGCOUNTRY { 0x1002 }
+sub LOCALE_SABBREVCTRYNAME { 0x0007 }
+sub LOCALE_SNATIVECTRYNAME { 0x0008 }
+sub LOCALE_IDEFAULTLANGUAGE { 0x0009 }
+sub LOCALE_IDEFAULTCOUNTRY { 0x000A }
+sub LOCALE_IDEFAULTCODEPAGE { 0x000B }
+sub LOCALE_IDEFAULTANSICODEPAGE { 0x1004 }
+sub LOCALE_SLIST { 0x000C }
+sub LOCALE_IMEASURE { 0x000D }
+sub LOCALE_SDECIMAL { 0x000E }
+sub LOCALE_STHOUSAND { 0x000F }
+sub LOCALE_SGROUPING { 0x0010 }
+sub LOCALE_IDIGITS { 0x0011 }
+sub LOCALE_ILZERO { 0x0012 }
+sub LOCALE_INEGNUMBER { 0x1010 }
+sub LOCALE_SNATIVEDIGITS { 0x0013 }
+sub LOCALE_SCURRENCY { 0x0014 }
+sub LOCALE_SINTLSYMBOL { 0x0015 }
+sub LOCALE_SMONDECIMALSEP { 0x0016 }
+sub LOCALE_SMONTHOUSANDSEP { 0x0017 }
+sub LOCALE_SMONGROUPING { 0x0018 }
+sub LOCALE_ICURRDIGITS { 0x0019 }
+sub LOCALE_IINTLCURRDIGITS { 0x001A }
+sub LOCALE_ICURRENCY { 0x001B }
+sub LOCALE_INEGCURR { 0x001C }
+sub LOCALE_SDATE { 0x001D }
+sub LOCALE_STIME { 0x001E }
+sub LOCALE_SSHORTDATE { 0x001F }
+sub LOCALE_SLONGDATE { 0x0020 }
+sub LOCALE_STIMEFORMAT { 0x1003 }
+sub LOCALE_IDATE { 0x0021 }
+sub LOCALE_ILDATE { 0x0022 }
+sub LOCALE_ITIME { 0x0023 }
+sub LOCALE_ITIMEMARKPOSN { 0x1005 }
+sub LOCALE_ICENTURY { 0x0024 }
+sub LOCALE_ITLZERO { 0x0025 }
+sub LOCALE_IDAYLZERO { 0x0026 }
+sub LOCALE_IMONLZERO { 0x0027 }
+sub LOCALE_S1159 { 0x0028 }
+sub LOCALE_S2359 { 0x0029 }
+sub LOCALE_ICALENDARTYPE { 0x1009 }
+sub LOCALE_IOPTIONALCALENDAR { 0x100B }
+sub LOCALE_IFIRSTDAYOFWEEK { 0x100C }
+sub LOCALE_IFIRSTWEEKOFYEAR { 0x100D }
+sub LOCALE_SDAYNAME1 { 0x002A }
+sub LOCALE_SDAYNAME2 { 0x002B }
+sub LOCALE_SDAYNAME3 { 0x002C }
+sub LOCALE_SDAYNAME4 { 0x002D }
+sub LOCALE_SDAYNAME5 { 0x002E }
+sub LOCALE_SDAYNAME6 { 0x002F }
+sub LOCALE_SDAYNAME7 { 0x0030 }
+sub LOCALE_SABBREVDAYNAME1 { 0x0031 }
+sub LOCALE_SABBREVDAYNAME2 { 0x0032 }
+sub LOCALE_SABBREVDAYNAME3 { 0x0033 }
+sub LOCALE_SABBREVDAYNAME4 { 0x0034 }
+sub LOCALE_SABBREVDAYNAME5 { 0x0035 }
+sub LOCALE_SABBREVDAYNAME6 { 0x0036 }
+sub LOCALE_SABBREVDAYNAME7 { 0x0037 }
+sub LOCALE_SMONTHNAME1 { 0x0038 }
+sub LOCALE_SMONTHNAME2 { 0x0039 }
+sub LOCALE_SMONTHNAME3 { 0x003A }
+sub LOCALE_SMONTHNAME4 { 0x003B }
+sub LOCALE_SMONTHNAME5 { 0x003C }
+sub LOCALE_SMONTHNAME6 { 0x003D }
+sub LOCALE_SMONTHNAME7 { 0x003E }
+sub LOCALE_SMONTHNAME8 { 0x003F }
+sub LOCALE_SMONTHNAME9 { 0x0040 }
+sub LOCALE_SMONTHNAME10 { 0x0041 }
+sub LOCALE_SMONTHNAME11 { 0x0042 }
+sub LOCALE_SMONTHNAME12 { 0x0043 }
+sub LOCALE_SMONTHNAME13 { 0x100E }
+sub LOCALE_SABBREVMONTHNAME1 { 0x0044 }
+sub LOCALE_SABBREVMONTHNAME2 { 0x0045 }
+sub LOCALE_SABBREVMONTHNAME3 { 0x0046 }
+sub LOCALE_SABBREVMONTHNAME4 { 0x0047 }
+sub LOCALE_SABBREVMONTHNAME5 { 0x0048 }
+sub LOCALE_SABBREVMONTHNAME6 { 0x0049 }
+sub LOCALE_SABBREVMONTHNAME7 { 0x004A }
+sub LOCALE_SABBREVMONTHNAME8 { 0x004B }
+sub LOCALE_SABBREVMONTHNAME9 { 0x004C }
+sub LOCALE_SABBREVMONTHNAME10 { 0x004D }
+sub LOCALE_SABBREVMONTHNAME11 { 0x004E }
+sub LOCALE_SABBREVMONTHNAME12 { 0x004F }
+sub LOCALE_SABBREVMONTHNAME13 { 0x100F }
+sub LOCALE_SPOSITIVESIGN { 0x0050 }
+sub LOCALE_SNEGATIVESIGN { 0x0051 }
+sub LOCALE_IPOSSIGNPOSN { 0x0052 }
+sub LOCALE_INEGSIGNPOSN { 0x0053 }
+sub LOCALE_IPOSSYMPRECEDES { 0x0054 }
+sub LOCALE_IPOSSEPBYSPACE { 0x0055 }
+sub LOCALE_INEGSYMPRECEDES { 0x0056 }
+sub LOCALE_INEGSEPBYSPACE { 0x0057 }
+
+# GetTimeFormat Flags
+sub TIME_NOMINUTESORSECONDS { 0x0001 }
+sub TIME_NOSECONDS { 0x0002 }
+sub TIME_NOTIMEMARKER { 0x0004 }
+sub TIME_FORCE24HOURFORMAT { 0x0008 }
+
+# GetDateFormat Flags
+sub DATE_SHORTDATE { 0x0001 }
+sub DATE_LONGDATE { 0x0002 }
+sub DATE_USE_ALT_CALENDAR { 0x0004 }
+sub DATE_YEARMONTH { 0x0008 }
+sub DATE_LTRREADING { 0x0010 }
+sub DATE_RTLREADING { 0x0020 }
+
+# Language Identifier Functions
+sub MAKELANGID { my ($p,$s) = @_; (($s & 0xffff) << 10) | ($p & 0xffff); }
+sub PRIMARYLANGID { my $lgid = shift; $lgid & 0x3ff; }
+sub SUBLANGID { my $lgid = shift; ($lgid >> 10) & 0x3f; }
+
+sub LANG_SYSTEM_DEFAULT { MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT); }
+sub LANG_USER_DEFAULT { MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT); }
+
+# Locale Identifier Functions
+sub MAKELCID { my $lgid = shift; $lgid & 0xffff; }
+sub LANGIDFROMLCID { my $lcid = shift; $lcid & 0xffff; }
+
+sub LOCALE_SYSTEM_DEFAULT { MAKELCID(LANG_SYSTEM_DEFAULT); }
+sub LOCALE_USER_DEFAULT { MAKELCID(LANG_USER_DEFAULT); }
+
+1;
+
+__END__
+
+=head1 NAME
+
+Win32::OLE::NLS - OLE National Language Support
+
+=head1 SYNOPSIS
+
+ missing
+
+=head1 DESCRIPTION
+
+This module provides access to the national language support features
+in the F<OLENLS.DLL>.
+
+=head2 Functions
+
+=over 8
+
+=item CompareString(LCID,FLAGS,STR1,STR2)
+
+Compare STR1 and STR2 in the LCID locale. FLAGS indicate the character
+traits to be used or ignored when comparing the two strings.
+
+ NORM_IGNORECASE Ignore case
+ NORM_IGNOREKANATYPE Ignore hiragana/katakana character differences
+ NORM_IGNORENONSPACE Ignore accents, diacritics, and vowel marks
+ NORM_IGNORESYMBOLS Ignore symbols
+ NORM_IGNOREWIDTH Ignore character width
+
+Possible return values are:
+
+ 0 Function failed
+ 1 STR1 is less than STR2
+ 2 STR1 is equal to STR2
+ 3 STR1 is greater than STR2
+
+Note that you can subtract 2 from the return code to get values
+comparable to the C<cmp> operator.
+
+=item LCMapString(LCID,FLAGS,STR)
+
+LCMapString translates STR using LCID dependent translation.
+Flags contains a combination of the following options:
+
+ LCMAP_LOWERCASE Lowercase
+ LCMAP_UPPERCASE Uppercase
+ LCMAP_HALFWIDTH Narrow characters
+ LCMAP_FULLWIDTH Wide characters
+ LCMAP_HIRAGANA Hiragana
+ LCMAP_KATAKANA Katakana
+ LCMAP_SORTKEY Character sort key
+
+The following normalization options can be combined with C<LCMAP_SORTKEY>:
+
+ NORM_IGNORECASE Ignore case
+ NORM_IGNOREKANATYPE Ignore hiragana/katakana character differences
+ NORM_IGNORENONSPACE Ignore accents, diacritics, and vowel marks
+ NORM_IGNORESYMBOLS Ignore symbols
+ NORM_IGNOREWIDTH Ignore character width
+
+The return value is the translated string.
+
+=item GetLocaleInfo(LCID,LCTYPE)
+
+Retrieve locale setting LCTYPE from the locale specified by LCID. Use
+LOCALE_NOUSEROVERRIDE | LCTYPE to always query the locale database.
+Otherwise user changes to C<win.ini> through the windows control panel
+take precedence when retrieving values for the system default locale.
+See the documentation below for a list of valid LCTYPE values.
+
+The return value is the contents of the requested locale setting.
+
+=item GetStringType(LCID,TYPE,STR)
+
+Retrieve type information from locale LCID about each character in STR.
+The requested TYPE can be one of the following 3 levels:
+
+ CT_CTYPE1 ANSI C and POSIX type information
+ CT_CTYPE2 Text layout type information
+ CT_CTYPE3 Text processing type information
+
+The return value is a list of values, each of wich is a bitwise OR of
+the applicable type bits from the corresponding table below:
+
+ @ct = GetStringType(LOCALE_SYSTEM_DEFAULT, CT_CTYPE1, "String");
+
+ANSI C and POSIX character type information:
+
+ C1_UPPER Uppercase
+ C1_LOWER Lowercase
+ C1_DIGIT Decimal digits
+ C1_SPACE Space characters
+ C1_PUNCT Punctuation
+ C1_CNTRL Control characters
+ C1_BLANK Blank characters
+ C1_XDIGIT Hexadecimal digits
+ C1_ALPHA Any letter
+
+Text layout type information:
+
+ C2_LEFTTORIGHT Left to right
+ C2_RIGHTTOLEFT Right to left
+ C2_EUROPENUMBER European number, European digit
+ C2_EUROPESEPARATOR European numeric separator
+ C2_EUROPETERMINATOR European numeric terminator
+ C2_ARABICNUMBER Arabic number
+ C2_COMMONSEPARATOR Common numeric separator
+ C2_BLOCKSEPARATOR Block separator
+ C2_SEGMENTSEPARATOR Segment separator
+ C2_WHITESPACE White space
+ C2_OTHERNEUTRAL Other neutrals
+ C2_NOTAPPLICABLE No implicit direction (e.g. ctrl codes)
+
+Text precessing type information:
+
+ C3_NONSPACING Nonspacing mark
+ C3_DIACRITIC Diacritic nonspacing mark
+ C3_VOWELMARK Vowel nonspacing mark
+ C3_SYMBOL Symbol
+ C3_KATAKANA Katakana character
+ C3_HIRAGANA Hiragana character
+ C3_HALFWIDTH Narrow character
+ C3_FULLWIDTH Wide character
+ C3_IDEOGRAPH Ideograph
+ C3_ALPHA Any letter
+ C3_NOTAPPLICABLE Not applicable
+
+
+=item GetSystemDefaultLangID()
+
+Returns the system default language identifier.
+
+=item GetSystemDefaultLCID()
+
+Returns the system default locale identifier.
+
+=item GetUserDefaultLangID()
+
+Returns the user default language identifier.
+
+=item GetUserDefaultLCID()
+
+Returns the user default locale identifier.
+
+=item SendSettingChange()
+
+Sends a WM_SETTINGCHANGE message to all top level windows.
+
+=item SetLocaleInfo(LCID, LCTYPE, LCDATA)
+
+Changes an item in the user override part of the locale setting LCID.
+It doesn't change the system default database. The following LCTYPEs are
+changeable:
+
+ LOCALE_ICALENDARTYPE LOCALE_SDATE
+ LOCALE_ICURRDIGITS LOCALE_SDECIMAL
+ LOCALE_ICURRENCY LOCALE_SGROUPING
+ LOCALE_IDIGITS LOCALE_SLIST
+ LOCALE_IFIRSTDAYOFWEEK LOCALE_SLONGDATE
+ LOCALE_IFIRSTWEEKOFYEAR LOCALE_SMONDECIMALSEP
+ LOCALE_ILZERO LOCALE_SMONGROUPING
+ LOCALE_IMEASURE LOCALE_SMONTHOUSANDSEP
+ LOCALE_INEGCURR LOCALE_SNEGATIVESIGN
+ LOCALE_INEGNUMBER LOCALE_SPOSITIVESIGN
+ LOCALE_IPAPERSIZE LOCALE_SSHORTDATE
+ LOCALE_ITIME LOCALE_STHOUSAND
+ LOCALE_S1159 LOCALE_STIME
+ LOCALE_S2359 LOCALE_STIMEFORMAT
+ LOCALE_SCURRENCY LOCALE_SYEARMONTH
+
+You have to call SendSettingChange() to activate these changes for
+subsequent Win32::OLE::Variant object formatting because the OLE
+subsystem seems to cache locale information.
+
+=item MAKELANGID(LANG,SUBLANG)
+
+Creates a language identifier from a primary language and a sublanguage.
+
+=item PRIMARYLANGID(LANGID)
+
+Retrieves the primary language from a language identifier.
+
+=item SUBLANGID(LANGID)
+
+Retrieves the sublanguage from a language identifier.
+
+=item MAKELCID(LANGID)
+
+Creates a locale identifies from a language identifier.
+
+=item LANGIDFROMLCID(LCID)
+
+Retrieves a language identifier from a locale identifier.
+
+=back
+
+=head2 Locale Types
+
+=over 8
+
+=item LOCALE_ILANGUAGE
+
+The language identifier (in hex).
+
+=item LOCALE_SLANGUAGE
+
+The localized name of the language.
+
+=item LOCALE_SENGLANGUAGE
+
+The ISO Standard 639 English name of the language.
+
+=item LOCALE_SABBREVLANGNAME
+
+The three-letter abbreviated name of the language. The first two
+letters are from the ISO Standard 639 language name abbreviation. The
+third letter indicates the sublanguage type.
+
+=item LOCALE_SNATIVELANGNAME
+
+The native name of the language.
+
+=item LOCALE_ICOUNTRY
+
+The country code, which is based on international phone codes.
+
+=item LOCALE_SCOUNTRY
+
+The localized name of the country.
+
+=item LOCALE_SENGCOUNTRY
+
+The English name of the country.
+
+=item LOCALE_SABBREVCTRYNAME
+
+The ISO Standard 3166 abbreviated name of the country.
+
+=item LOCALE_SNATIVECTRYNAME
+
+The native name of the country.
+
+=item LOCALE_IDEFAULTLANGUAGE
+
+Language identifier for the principal language spoken in this
+locale.
+
+=item LOCALE_IDEFAULTCOUNTRY
+
+Country code for the principal country in this locale.
+
+=item LOCALE_IDEFAULTANSICODEPAGE
+
+The ANSI code page associated with this locale. Format: 4 Unicode
+decimal digits plus a Unicode null terminator.
+
+XXX This should be translated by GetLocaleInfo. XXX
+
+=item LOCALE_IDEFAULTCODEPAGE
+
+The OEM code page associated with the country.
+
+=item LOCALE_SLIST
+
+Characters used to separate list items (often a comma).
+
+=item LOCALE_IMEASURE
+
+Default measurement system:
+
+ 0 metric system (S.I.)
+ 1 U.S. system
+
+=item LOCALE_SDECIMAL
+
+Characters used for the decimal separator (often a dot).
+
+=item LOCALE_STHOUSAND
+
+Characters used as the separator between groups of digits left of the decimal.
+
+=item LOCALE_SGROUPING
+
+Sizes for each group of digits to the left of the decimal. An explicit
+size is required for each group. Sizes are separated by semicolons. If
+the last value is 0, the preceding value is repeated. To group
+thousands, specify 3;0.
+
+=item LOCALE_IDIGITS
+
+The number of fractional digits.
+
+=item LOCALE_ILZERO
+
+Whether to use leading zeros in decimal fields. A setting of 0
+means use no leading zeros; 1 means use leading zeros.
+
+=item LOCALE_SNATIVEDIGITS
+
+The ten characters that are the native equivalent of the ASCII 0-9.
+
+=item LOCALE_INEGNUMBER
+
+Negative number mode.
+
+ 0 (1.1)
+ 1 -1.1
+ 2 -1.1
+ 3 1.1
+ 4 1.1
+
+=item LOCALE_SCURRENCY
+
+The string used as the local monetary symbol.
+
+=item LOCALE_SINTLSYMBOL
+
+Three characters of the International monetary symbol specified in ISO
+4217, Codes for the Representation of Currencies and Funds, followed
+by the character separating this string from the amount.
+
+=item LOCALE_SMONDECIMALSEP
+
+Characters used for the monetary decimal separators.
+
+=item LOCALE_SMONTHOUSANDSEP
+
+Characters used as monetary separator between groups of digits left of
+the decimal.
+
+=item LOCALE_SMONGROUPING
+
+Sizes for each group of monetary digits to the left of the decimal. An
+explicit size is needed for each group. Sizes are separated by
+semicolons. If the last value is 0, the preceding value is
+repeated. To group thousands, specify 3;0.
+
+=item LOCALE_ICURRDIGITS
+
+Number of fractional digits for the local monetary format.
+
+=item LOCALE_IINTLCURRDIGITS
+
+Number of fractional digits for the international monetary format.
+
+=item LOCALE_ICURRENCY
+
+Positive currency mode.
+
+ 0 Prefix, no separation.
+ 1 Suffix, no separation.
+ 2 Prefix, 1-character separation.
+ 3 Suffix, 1-character separation.
+
+=item LOCALE_INEGCURR
+
+Negative currency mode.
+
+ 0 ($1.1)
+ 1 -$1.1
+ 2 $-1.1
+ 3 $1.1-
+ 4 $(1.1$)
+ 5 -1.1$
+ 6 1.1-$
+ 7 1.1$-
+ 8 -1.1 $ (space before $)
+ 9 -$ 1.1 (space after $)
+ 10 1.1 $- (space before $)
+
+=item LOCALE_ICALENDARTYPE
+
+The type of calendar currently in use.
+
+ 1 Gregorian (as in U.S.)
+ 2 Gregorian (always English strings)
+ 3 Era: Year of the Emperor (Japan)
+ 4 Era: Year of the Republic of China
+ 5 Tangun Era (Korea)
+
+=item LOCALE_IOPTIONALCALENDAR
+
+The additional calendar types available for this LCID. Can be a
+null-separated list of all valid optional calendars. Value is
+0 for "None available" or any of the LOCALE_ICALENDARTYPE settings.
+
+XXX null separated list should be translated by GetLocaleInfo XXX
+
+=item LOCALE_SDATE
+
+Characters used for the date separator.
+
+=item LOCALE_STIME
+
+Characters used for the time separator.
+
+=item LOCALE_STIMEFORMAT
+
+Time-formatting string.
+
+=item LOCALE_SSHORTDATE
+
+Short Date_Time formatting strings for this locale.
+
+=item LOCALE_SLONGDATE
+
+Long Date_Time formatting strings for this locale.
+
+=item LOCALE_IDATE
+
+Short Date format-ordering specifier.
+
+ 0 Month - Day - Year
+ 1 Day - Month - Year
+ 2 Year - Month - Day
+
+=item LOCALE_ILDATE
+
+Long Date format ordering specifier. Value can be any of the valid
+LOCALE_IDATE settings.
+
+=item LOCALE_ITIME
+
+Time format specifier.
+
+ 0 AM/PM 12-hour format.
+ 1 24-hour format.
+
+=item LOCALE_ITIMEMARKPOSN
+
+Whether the time marker string (AM|PM) precedes or follows the time
+string.
+ 0 Suffix (9:15 AM).
+ 1 Prefix (AM 9:15).
+
+=item LOCALE_ICENTURY
+
+Whether to use full 4-digit century.
+
+ 0 Two digit.
+ 1 Full century.
+
+=item LOCALE_ITLZERO
+
+Whether to use leading zeros in time fields.
+
+ 0 No leading zeros.
+ 1 Leading zeros for hours.
+
+=item LOCALE_IDAYLZERO
+
+Whether to use leading zeros in day fields. Values as for
+LOCALE_ITLZERO.
+
+=item LOCALE_IMONLZERO
+
+Whether to use leading zeros in month fields. Values as for
+LOCALE_ITLZERO.
+
+=item LOCALE_S1159
+
+String for the AM designator.
+
+=item LOCALE_S2359
+
+String for the PM designator.
+
+=item LOCALE_IFIRSTWEEKOFYEAR
+
+Specifies which week of the year is considered first.
+
+ 0 Week containing 1/1 is the first week of the year.
+ 1 First full week following 1/1is the first week of the year.
+ 2 First week with at least 4 days is the first week of the year.
+
+=item LOCALE_IFIRSTDAYOFWEEK
+
+Specifies the day considered first in the week. Value "0" means
+SDAYNAME1 and value "6" means SDAYNAME7.
+
+=item LOCALE_SDAYNAME1 .. LOCALE_SDAYNAME7
+
+Long name for Monday .. Sunday.
+
+=item LOCALE_SABBREVDAYNAME1 .. LOCALE_SABBREVDAYNAME7
+
+Abbreviated name for Monday .. Sunday.
+
+=item LOCALE_SMONTHNAME1 .. LOCALE_SMONTHNAME12
+
+Long name for January .. December.
+
+=item LOCALE_SMONTHNAME13
+
+Native name for 13th month, if it exists.
+
+=item LOCALE_SABBREVMONTHNAME1 .. LOCALE_SABBREVMONTHNAME12
+
+Abbreviated name for January .. December.
+
+=item LOCALE_SABBREVMONTHNAME13
+
+Native abbreviated name for 13th month, if it exists.
+
+=item LOCALE_SPOSITIVESIGN
+
+String value for the positive sign.
+
+=item LOCALE_SNEGATIVESIGN
+
+String value for the negative sign.
+
+=item LOCALE_IPOSSIGNPOSN
+
+Formatting index for positive values.
+
+ 0 Parentheses surround the amount and the monetary symbol.
+ 1 The sign string precedes the amount and the monetary symbol.
+ 2 The sign string precedes the amount and the monetary symbol.
+ 3 The sign string precedes the amount and the monetary symbol.
+ 4 The sign string precedes the amount and the monetary symbol.
+
+=item LOCALE_INEGSIGNPOSN
+
+Formatting index for negative values. Values as for LOCALE_IPOSSIGNPOSN.
+
+=item LOCALE_IPOSSYMPRECEDES
+
+If the monetary symbol precedes, 1. If it succeeds a positive amount, 0.
+
+=item LOCALE_IPOSSEPBYSPACE
+
+If the monetary symbol is separated by a space from a positive amount,
+1. Otherwise, 0.
+
+=item LOCALE_INEGSYMPRECEDES
+
+If the monetary symbol precedes, 1. If it succeeds a negative amount, 0.
+
+=item LOCALE_INEGSEPBYSPACE
+
+If the monetary symbol is separated by a space from a negative amount,
+1. Otherwise, 0.
+
+=back
+
+=head1 AUTHORS/COPYRIGHT
+
+This module is part of the Win32::OLE distribution.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod
new file mode 100644
index 0000000000..e45770baa4
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/TPJ.pod
@@ -0,0 +1,798 @@
+=pod
+
+=head1 NAME
+
+The Perl Journal #10 - Win32::OLE by Jan Dubois
+
+=head1 INTRODUCTION
+
+Suppose you're composing a document with Microsoft Word. You want to
+include an Excel spreadsheet. You could save the spreadsheet in some
+image format that Word can understand, and import it into your
+document. But if the spreadsheet changes, your document will be out of
+date.
+
+Microsoft's OLE (Object Linking and Embedding, pronounced "olay") lets
+one program use objects from another. In the above scenario, the
+spreadsheet is the object. As long as Excel makes that spreadsheet
+available as an OLE object, and Word knows to treat it like one, your
+document will always be current.
+
+You can control OLE objects from Perl with the Win32::OLE module, and
+that's what this article is about. First, I'll show you how to "think
+OLE," which mostly involves a lot of jargon. Next, I'll show you the
+mechanics involved in using Win32::OLE. Then we'll go through a Perl
+program that uses OLE to manipulate Microsoft Excel, Microsoft Access,
+and Lotus Notes. Finally, I'll talk about Variants, an internal OLE
+data type.
+
+
+=head1 THE OLE MINDSET
+
+When an application makes an OLE object available for other
+applications to use, that's called OLE I<automation>. The program
+using the object is called the I<controller>, and the application
+providing the object is called the I<server>. OLE automation is guided
+by the OLE Component Object Model (COM) which specifies how those
+objects must behave if they are to be used by other processes and
+machines.
+
+There are two different types of OLE automation servers. I<In-process>
+servers are implemented as dynamic link libraries (DLLs) and run in
+the same process space as the controller. I<Out-of-process> servers
+are more interesting; they are standalone executables that exist as
+separate processes - possibly on a different computer.
+
+The Win32::OLE module lets your Perl program act as an OLE
+controller. It allows Perl to be used in place of other languages like
+Visual Basic or Java to control OLE objects. This makes all OLE
+automation servers immediately available as Perl modules.
+
+Don't confuse ActiveState OLE with Win32::OLE. ActiveState OLE is
+completely different, although future builds of ActiveState Perl (500
+and up) will work with Win32::OLE.
+
+Objects can expose OLE methods, properties, and events to the outside
+world. Methods are functions that the controller can call to make the
+object do something; properties describe the state of the object; and
+events let the controller know about external events affecting the
+object, such as the user clicking on a button. Since events involve
+asynchronous communication with their objects, they require either
+threads or an event loop. They are not yet supported by the Win32::OLE
+module, and for the same reason ActiveX controls (OCXs) are currently
+unsupported as well.
+
+=head1 WORKING WITH WIN32::OLE
+
+The Win32::OLE module doesn't let your Perl program create OLE
+objects. What it does do is let your Perl program act like a remote
+control for other applications-it lets your program be an OLE
+controller. You can take an OLE object from another application
+(Access, Notes, Excel, or anything else that speaks OLE) and invoke
+its methods or manipulate its properties.
+
+=head2 THE FIRST STEP: CREATING AN OLE SERVER OBJECT
+
+First, we need to create a Perl object to represent the OLE
+server. This is a weird idea; what it amounts to is that if we want to
+control OLE objects produced by, say, Excel, we have to create a Perl
+object that represents Excel. So even though our program is an OLE
+controller, it'll contain objects that represent OLE servers.
+
+You can create a new OLE I<server object> with C<< Win32::OLE->new >>.
+This takes a program ID (a human readable string like
+C<'Speech.VoiceText'>) and returns a server object:
+
+ my $server = Win32::OLE->new('Excel.Application', 'Quit');
+
+Some server objects (particularly those for Microsoft Office
+applications) don't automatically terminate when your program no
+longer needs them. They need some kind of Quit method, and that's just
+what our second argument is. It can be either a code reference or a
+method name to be invoked when the object is destroyed. This lets you
+ensure that objects will be properly cleaned up even when the Perl
+program dies abnormally.
+
+To access a server object on a different computer, replace the first
+argument with a reference to a list of the server name and program ID:
+
+ my $server = Win32::OLE->new(['foo.bar.com',
+ 'Excel.Application']);
+
+(To get the requisite permissions, you'll need to configure your
+security settings with F<DCOMCNFG.EXE>.)
+
+You can also directly attach your program to an already running OLE
+server:
+
+ my $server = Win32::OLE->GetActiveObject('Excel.Application');
+
+This fails (returning C<undef>) if no server exists, or if the server
+refuses the connection for some reason. It is also possible to use a
+persistent object moniker (usually a filename) to start the associated
+server and load the object into memory:
+
+ my $doc = Win32::OLE->GetObject("MyDocument.Doc");
+
+=head2 METHOD CALLS
+
+Once you've created one of these server objects, you need to call its
+methods to make the OLE objects sing and dance. OLE methods are
+invoked just like normal Perl object methods:
+
+ $server->Foo(@Arguments);
+
+This is a Perl method call - but it also triggers an OLE method call
+in the object. After your program executes this statement, the
+C<$server> object will execute its Foo() method. The available methods
+are typically documented in the application's I<object model>.
+
+B<Parameters.> By default, all parameters are positional
+(e.g. C<foo($first, $second, $third)>) rather than named (e.g.
+C<< foo(-name => "Yogi", -title => "Coach") >>). The required parameters
+come first, followed by the optional parameters; if you need to
+provide a dummy value for an optional parameter, use undef.
+
+Positional parameters get cumbersome if a method takes a lot of
+them. You can use named arguments instead if you go to a little extra
+trouble - when the last argument is a reference to a hash, the
+key/value pairs of the hash are treated as named parameters:
+
+ $server->Foo($Pos1, $Pos2, {Name1 => $Value1,
+ Name2 => $Value2});
+
+B<Foreign Languages and Default Methods.> Sometimes OLE servers use
+method and property names that are specific to a non-English
+locale. That means they might have non-ASCII characters, which aren't
+allowed in Perl variable names. In German, you might see C<Öffnen> used
+instead of C<Open>. In these cases, you can use the Invoke() method:
+
+ $server->Invoke('Öffnen', @Arguments);
+
+This is necessary because C<< $Server->Öffnen(@Arguments) >> is a syntax
+error in current versions of Perl.
+
+=head2 PROPERTIES
+
+As I said earlier, objects can expose three things to the outside
+world: methods, properties, and events. We've covered methods, and
+Win32::OLE can't handle events. That leaves properties. But as it
+turns out, properties and events are largely interchangeable. Most
+methods have corresponding properties, and vice versa.
+
+An object's properties can be accessed with a hash reference:
+
+ $server->{Bar} = $value;
+ $value = $server->{Bar};
+
+This example sets and queries the value of the property named
+C<Bar>. You could also have called the object's Bar() method to
+achieve the same effect:
+
+ $value = $server->Bar;
+
+However, you can't write the first line as C<< $server->Bar = $value >>,
+because you can't assign to the return value of a method call. In
+Visual Basic, OLE automation distinguishes between assigning the name
+of an object and assigning its value:
+
+ Set Object = OtherObject
+
+ Let Value = Object
+
+The C<Set> statement shown here makes C<Object> refer to the same object as
+C<OtherObject>. The C<Let> statement copies the value instead. (The value of
+an OLE object is what you get when you call the object's default
+method.
+
+In Perl, saying C<< $server1 = $server2 >> always creates another reference,
+just like the C<Set> in Visual Basic. If you want to assign the value
+instead, use the valof() function:
+
+ my $value = valof $server;
+
+This is equivalent to
+
+ my $value = $server->Invoke('');
+
+=head2 SAMPLE APPLICATION
+
+Let's look at how all of this might be used. In Listing: 1 you'll see
+F<T-Bond.pl>, a program that uses Win32::OLE for an almost-real world
+application.
+
+The developer of this application, Mary Lynch, is a financial futures
+broker. Every afternoon, she connects to the Chicago Board of Trade
+(CBoT) web site at http://www.cbot.com and collects the time and sales
+information for U.S. T-bond futures. She wants her program to create a
+chart that depicts the data in 15-minute intervals, and then she wants
+to record the data in a database for later analysis. Then she wants
+her program to send mail to her clients.
+
+Mary's program will use Microsoft Access as a database, Microsoft
+Excel to produce the chart, and Lotus Notes to send the mail. It will
+all be controlled from a single Perl program using OLE automation. In
+this section, we'll go through T-Bond. pl step by step so you can see
+how Win32::OLE lets you control these applications.
+
+=head2 DOWNLOADING A WEB PAGE WITH LWP
+
+However, Mary first needs to amass the raw T-bond data by having her
+Perl program automatically download and parse a web page. That's the
+perfect job for LWP, the libwww-perl bundle available on the CPAN. LWP
+has nothing to do with OLE. But this is a real-world application, and
+it's just what Mary needs to download her data from the Chicago Board
+of Trade.
+
+ use LWP::Simple;
+ my $URL = 'http://www.cbot.com/mplex/quotes/tsfut';
+ my $text = get("$URL/tsf$Contract.htm");
+
+She could also have used the Win32::Internet module:
+
+ use Win32::Internet;
+ my $URL = 'http://www.cbot.com/mplex/quotes/tsfut';
+ my $text = $Win32::Internet->new->FetchURL("$URL/tsf$Contract.htm");
+
+Mary wants to condense the ticker data into 15 minute bars. She's
+interested only in lines that look like this:
+
+ 03/12/1998 US 98Mar 12116 15:28:34 Open
+
+A regular expression can be used to determine whether a line looks
+like this. If it does, the regex can split it up into individual
+fields. The price quoted above, C<12116>, really means 121 16/32, and
+needs to be converted to 121.5. The data is then condensed into 15
+minute intervals and only the first, last, highest, and lowest price
+during each interval are kept. The time series is stored in the array
+C<@Bars>. Each entry in C<@Bars> is a reference to a list of 5 elements:
+Time, Open, High, Low, and Close.
+
+ foreach (split "\n", $text) {
+ # 03/12/1998 US 98Mar 12116 15:28:34 Open
+ my ($Date,$Price,$Hour,$Min,$Sec,$Ind) =
+ m|^\s*(\d+/\d+/\d+) # " 03/12/1998"
+ \s+US\s+\S+\s+(\d+) # " US 98Mar 12116"
+ \s+(\d+):(\d+):(\d+) # " 12:42:40"
+ \s*(.*)$|x; # " Ask"
+ next unless defined $Date;
+ $Day = $Date;
+
+ # Convert from fractional to decimal format
+ $Price = int($Price/100) + ($Price%100)/32;
+
+ # Round up time to next multiple of 15 minutes
+ my $NewTime = int(($Sec+$Min*60+$Hour*3600)/900+1)*900;
+ unless (defined $Time && $NewTime == $Time) {
+ push @Bars, [$hhmm, $Open, $High, $Low, $Close]
+ if defined $Time;
+ $Open = $High = $Low = $Close = undef;
+ $Time = $NewTime;
+ my $Hour = int($Time/3600);
+ $hhmm = sprintf "%02d:%02d", $Hour, $Time/60-$Hour*60;
+ }
+
+ # Update 15 minute bar values
+ $Close = $Price;
+ $Open = $Price unless defined $Open;
+ $High = $Price unless defined $High && $High > $Price;
+ $Low = $Price unless defined $Low && $Low > $Price;
+ }
+
+ die "No data found" unless defined $Time;
+ push @Bars, [$hhmm, $Open, $High, $Low, $Close];
+
+=head2 MICROSOFT ACCESS
+
+Now that Mary has her T-bond quotes, she's ready to use Win32::OLE to
+store them into a Microsoft Access database. This has the advantage
+that she can copy the database to her lap-top and work with it on her
+long New York commute. She's able to create an Access database as
+follows:
+
+ use Win32::ODBC;
+ use Win32::OLE;
+
+ # Include the constants for the Microsoft Access
+ # "Data Access Object".
+
+ use Win32::OLE::Const 'Microsoft DAO';
+
+ my $DSN = 'T-Bonds';
+ my $Driver = 'Microsoft Access Driver (*.mdb)';
+ my $Desc = 'US T-Bond Quotes';
+ my $Dir = 'i:\tmp\tpj';
+ my $File = 'T-Bonds.mdb';
+ my $Fullname = "$Dir\\$File";
+
+ # Remove old database and dataset name
+ unlink $Fullname if -f $Fullname;
+ Win32::ODBC::ConfigDSN(ODBC_REMOVE_DSN, $Driver, "DSN=$DSN")
+ if Win32::ODBC::DataSources($DSN);
+
+ # Create new database
+ my $Access = Win32::OLE->new('Access.Application', 'Quit');
+ my $Workspace = $Access->DBEngine->CreateWorkspace('', 'Admin', '');
+ my $Database = $Workspace->CreateDatabase($Fullname, dbLangGeneral);
+
+ # Add new database name
+ Win32::ODBC::ConfigDSN(ODBC_ADD_DSN, $Driver,
+ "DSN=$DSN", "Description=$Desc", "DBQ=$Fullname",
+ "DEFAULTDIR=$Dir", "UID=", "PWD=");
+
+This uses Win32::ODBC (described in TPJ #9) to remove and create
+F<T-Bonds.mdb>. This lets Mary use the same script on her workstation
+and on her laptop even when the database is stored in different
+locations on each. The program also uses Win32::OLE to make Microsoft
+Access create an empty database.
+
+Every OLE server has some constants that your Perl program will need
+to use, made accessible by the Win32::OLE::Const module. For instance,
+to grab the Excel constants, say C<use Win32::OLE::Const 'Microsoft
+Excel'>.
+
+In the above example, we imported the Data Access Object con-stants
+just so we could use C<dbLangGeneral>.
+
+=head2 MICROSOFT EXCEL
+
+Now Mary uses Win32::OLE a second time, to have Microsoft Excel create
+the chart shown below.
+
+ Figure 1: T-Bond data generated by MicroSoft Excel via Win32::OLE
+
+ # Start Excel and create new workbook with a single sheet
+ use Win32::OLE qw(in valof with);
+ use Win32::OLE::Const 'Microsoft Excel';
+ use Win32::OLE::NLS qw(:DEFAULT :LANG :SUBLANG);
+
+ my $lgid = MAKELANGID(LANG_ENGLISH, SUBLANG_DEFAULT);
+ $Win32::OLE::LCID = MAKELCID($lgid);
+
+ $Win32::OLE::Warn = 3;
+
+Here, Mary sets the locale to American English, which lets her do
+things like use American date formats (e.g. C<"12-30-98"> rather than
+C<"30-12-98">) in her program. It will continue to work even when she's
+visiting one of her international customers and has to run this
+program on their computers.
+
+The value of C<$Win32::OLE::Warn> determines what happens when an OLE
+error occurs. If it's 0, the error is ignored. If it's 2, or if it's 1
+and the script is running under C<-w>, the Win32::OLE module invokes
+C<Carp::carp()>. If C<$Win32::OLE::Warn> is set to 3, C<Carp::croak()>
+is invoked and the program dies immediately.
+
+Now the data can be put into an Excel spreadsheet to produce the
+chart. The following section of the program launches Excel and creates
+a new workbook with a single worksheet. It puts the column titles
+('Time', 'Open', 'High', 'Low', and 'Close') in a bold font on the
+first row of the sheet. The first column displays the timestamp in
+I<hh:mm> format; the next four display prices.
+
+ my $Excel = Win32::OLE->new('Excel.Application', 'Quit');
+ $Excel->{SheetsInNewWorkbook} = 1;
+ my $Book = $Excel->Workbooks->Add;
+ my $Sheet = $Book->Worksheets(1);
+ $Sheet->{Name} = 'Candle';
+
+ # Insert column titles
+ my $Range = $Sheet->Range("A1:E1");
+ $Range->{Value} = [qw(Time Open High Low Close)];
+ $Range->Font->{Bold} = 1;
+
+ $Sheet->Columns("A:A")->{NumberFormat} = "h:mm";
+ # Open/High/Low/Close to be displayed in 32nds
+ $Sheet->Columns("B:E")->{NumberFormat} = "# ?/32";
+
+ # Add 15 minute data to spreadsheet
+ print "Add data\n";
+ $Range = $Sheet->Range(sprintf "A2:E%d", 2+$#Bars);
+ $Range->{Value} = \@Bars;
+
+The last statement shows how to pass arrays to OLE objects. The
+Win32::OLE module automatically translates each array reference to a
+C<SAFEARRAY>, the internal OLE array data type. This translation first
+determines the maximum nesting level used by the Perl array, and then
+creates a C<SAFEARRAY> of the same dimension. The C<@Bars> array
+already contains the data in the correct form for the spreadsheet:
+
+ ([Time1, Open1, High1, Low1, Close1],
+ ...
+ [TimeN, OpenN, HighN, LowN, CloseN])
+
+Now the table in the spreadsheet can be used to create a candle stick
+chart from our bars. Excel automatically chooses the time axis labels
+if they are selected before the chart is created:
+
+ # Create candle stick chart as new object on worksheet
+ $Sheet->Range("A:E")->Select;
+
+ my $Chart = $Book->Charts->Add;
+ $Chart->{ChartType} = xlStockOHLC;
+ $Chart->Location(xlLocationAsObject, $Sheet->{Name});
+ # Excel bug: the old $Chart is now invalid!
+ $Chart = $Excel->ActiveChart;
+
+We can change the type of the chart from a separate sheet to a chart
+object on the spreadsheet page with the C<< $Chart->Location >>
+method. (This invalidates the chart object handle, which might be
+considered a bug in Excel.) Fortunately, this new chart is still the
+'active' chart, so an object handle to it can be reclaimed simply by
+asking Excel.
+
+At this point, our chart still needs a title, the legend is
+meaningless, and the axis has decimals instead of fractions. We can
+fix those with the following code:
+
+ # Add title, remove legend
+ with($Chart, HasLegend => 0, HasTitle => 1);
+ $Chart->ChartTitle->Characters->{Text} = "US T-Bond";
+
+ # Set up daily statistics
+ $Open = $Bars[0][1];
+ $High = $Sheet->Evaluate("MAX(C:C)");
+ $Low = $Sheet->Evaluate("MIN(D:D)");
+ $Close = $Bars[$#Bars][4];
+
+The with() function partially mimics the Visual Basic With statement,
+but allows only property assignments. It's a convenient shortcut for
+this:
+
+ { # open new scope
+ my $Axis = $Chart->Axes(xlValue);
+ $Axis->{HasMajorGridlines} = 1;
+ $Axis->{HasMinorGridlines} = 1;
+ # etc ...
+ }
+
+The C<$High> and C<$Low> for the day are needed to determine the
+minimum and maximum scaling levels. MIN and MAX are spreadsheet
+functions, and aren't automatically available as methods. However,
+Excel provides an Evaluate() method to calculate arbitrary spreadsheet
+functions, so we can use that.
+
+We want the chart to show major gridlines at every fourth tick and
+minor gridlines at every second tick. The minimum and maximum are
+chosen to be whatever multiples of 1/16 we need to do that.
+
+ # Change tickmark spacing from decimal to fractional
+ with($Chart->Axes(xlValue),
+ HasMajorGridlines => 1,
+ HasMinorGridlines => 1,
+ MajorUnit => 1/8,
+ MinorUnit => 1/16,
+ MinimumScale => int($Low*16)/16,
+ MaximumScale => int($High*16+1)/16
+ );
+
+ # Fat candles with only 5% gaps
+ $Chart->ChartGroups(1)->{GapWidth} = 5;
+
+ sub RGB { $_[0] | ($_[1] >> 8) | ($_[2] >> 16) }
+
+ # White background with a solid border
+
+ $Chart->PlotArea->Border->{LineStyle} = xlContinuous;
+ $Chart->PlotArea->Border->{Color} = RGB(0,0,0);
+ $Chart->PlotArea->Interior->{Color} = RGB(255,255,255);
+
+ # Add 1 hour moving average of the Close series
+ my $MovAvg = $Chart->SeriesCollection(4)->Trendlines
+ ->Add({Type => xlMovingAvg, Period => 4});
+ $MovAvg->Border->{Color} = RGB(255,0,0);
+
+Now the finished workbook can be saved to disk as
+F<i:\tmp\tpj\data.xls>. That file most likely still exists from when the
+program ran yesterday, so we'll remove it. (Otherwise, Excel would pop
+up a dialog with a warning, because the SaveAs() method doesn't like
+to overwrite files.)
+
+
+ # Save workbook to file my $Filename = 'i:\tmp\tpj\data.xls';
+ unlink $Filename if -f $Filename;
+ $Book->SaveAs($Filename);
+ $Book->Close;
+
+=head2 ACTIVEX DATA OBJECTS
+
+Mary stores the daily prices in her T-bonds database, keeping the data
+for the different contracts in separate tables. After creating an ADO
+(ActiveX Data Object) connection to the database, she tries to connect
+a record set to the table for the current contract. If this fails, she
+assumes that the table doesn't exists yet and tries to create it:
+
+ use Win32::OLE::Const 'Microsoft ActiveX Data Objects';
+
+ my $Connection = Win32::OLE->new('ADODB.Connection');
+ my $Recordset = Win32::OLE->new('ADODB.Recordset');
+ $Connection->Open('T-Bonds');
+
+ # Open a record set for the table of this contract
+ {
+ local $Win32::OLE::Warn = 0;
+ $Recordset->Open($Contract, $Connection, adOpenKeyset,
+ adLockOptimistic, adCmdTable);
+ }
+
+ # Create table and index if it doesn't exist yet
+ if (Win32::OLE->LastError) {
+ $Connection->Execute(<<"SQL");
+ CREATE TABLE $Contract
+ (
+ Day DATETIME,
+ Open DOUBLE, High DOUBLE, Low DOUBLE, Close DOUBLE
+ )
+ SQL
+ $Connection->Execute(<<"SQL");
+ CREATE INDEX $Contract
+ ON $Contract (Day) WITH PRIMARY
+ SQL
+ $Recordset->Open($Contract, $Connection, adOpenKeyset,
+ adLockOptimistic, adCmdTable);
+ }
+
+C<$Win32::OLE::Warn> is temporarily set to zero, so that if
+C<$Recordset->Open> fails, the failure will be recorded silently without
+terminating the program. C<Win32::OLE->LastError> shows whether the Open
+failed or not. C<LastError> returns the OLE error code in a numeric
+context and the OLE error message in a string context, just like
+Perl's C<$!> variable.
+
+Now Mary can add today's data:
+
+ # Add new record to table
+ use Win32::OLE::Variant;
+ $Win32::OLE::Variant::LCID = $Win32::OLE::LCID;
+
+ my $Fields = [qw(Day Open High Low Close)];
+ my $Values = [Variant(VT_DATE, $Day),
+ $Open, $High, $Low, $Close];
+
+Mary uses the Win32::OLE::Variant module to store C<$Day> as a date
+instead of a mere string. She wants to make sure that it's stored as
+an American-style date, so in the third line shown here she sets the
+locale ID of the Win32::OLE::Variant module to match the Win32::OLE
+module. (C<$Win32::OLE::LCID> had been set earlier to English, since
+that's what the Chicago Board of Trade uses.)
+
+ {
+ local $Win32::OLE::Warn = 0;
+ $Recordset->AddNew($Fields, $Values);
+ }
+
+ # Replace existing record
+ if (Win32::OLE->LastError) {
+ $Recordset->CancelUpdate;
+ $Recordset->Close;
+ $Recordset->Open(<<"SQL", $Connection, adOpenDynamic);
+ SELECT * FROM $Contract
+ WHERE Day = #$Day#
+ SQL
+ $Recordset->Update($Fields, $Values);
+ }
+
+ $Recordset->Close;
+ $Connection->Close;
+
+The program expects to be able to add a new record to the table. It
+fails if a record for this date already exists, because the Day field
+is the primary index and therefore must be unique. If an error occurs,
+the update operation started by AddNew() must first be cancelled with
+C<< $Recordset->CancelUpdate >>; otherwise the record set won't close.
+
+=head2 LOTUS NOTES
+
+Now Mary can use Lotus Notes to mail updates to all her customers
+interested in the T-bond data. (Lotus Notes doesn't provide its
+constants in the OLE type library, so Mary had to determine them by
+playing around with LotusScript.) The actual task is quite simple: A
+Notes session must be started, the mail database must be opened and
+the mail message must be created. The body of the message is created
+as a rich text field, which lets her mix formatted text with object
+attachments.
+
+In her program, Mary extracts the email addresses from her customer
+database and sends separate message to each. Here, we've simplified it
+somewhat.
+
+ sub EMBED_ATTACHMENT {1454;} # from LotusScript
+
+ my $Notes = Win32::OLE->new('Notes.NotesSession');
+ my $Database = $Notes->GetDatabase('', '');
+ $Database->OpenMail;
+ my $Document = $Database->CreateDocument;
+
+ $Document->{Form} = 'Memo';
+ $Document->{SendTo} = ['Jon Orwant >orwant@tpj.com>',
+ 'Jan Dubois >jan.dubois@ibm.net>'];
+ $Document->{Subject} = "US T-Bonds Chart for $Day";
+
+ my $Body = $Document->CreateRichtextItem('Body');
+ $Body->AppendText(<<"EOT");
+ I\'ve attached the latest US T-Bond data and chart for $Day.
+ The daily statistics were:
+
+ \tOpen\t$Open
+ \tHigh\t$High
+ \tLow\t$Low
+ \tClose\t$Close
+
+ Kind regards,
+
+ Mary
+ EOT
+
+ $Body->EmbedObject(EMBED_ATTACHMENT, '', $Filename);
+
+ $Document->Send(0);
+
+=head1 VARIANTS
+
+In this final section, I'll talk about Variants, which are the data
+types that you use to talk to OLE objects. We talked about this line
+earlier:
+
+ my $Values = [Variant(VT_DATE, $Day),
+ $Open, $High, $Low, $Close];
+
+Here, the Variant() function creates a Variant object, of type C<VT_DATE>
+and with the value C<$Day>. Variants are similar in many ways to Perl
+scalars. Arguments to OLE methods are transparently converted from
+their internal Perl representation to Variants and back again by the
+Win32::OLE module.
+
+OLE automation uses a generic C<VARIANT> data type to pass
+parameters. This data type contains type information in addition to
+the actual data value. Only the following data types are valid for OLE
+automation:
+
+ B<Data Type Meaning>
+ VT_EMPTY Not specified
+ VT_NULL Null
+ VT_I2 2 byte signed integer
+ VT_I4 4 byte signed integer
+ VT_R4 4 byte real
+ VT_R8 8 byte real
+ VT_CY Currency
+ VT_DATE Date
+ VT_BSTR Unicode string
+ VT_DISPATCH OLE automation interface
+ VT_ERROR Error
+ VT_BOOL Boolean
+ VT_VARIANT (only valid with VT_BYREF)
+ VT_UNKNOWN Generic COM interface
+ VT_UI1 Unsigned character
+
+The following two flags can also be used:
+
+ VT_ARRAY Array of values
+ VT_BYREF Pass by reference (instead of by value)
+
+B<The Perl to Variant transformation.> The following conversions are
+performed automatically whenever a Perl value must be translated into
+a Variant:
+
+ Perl value Variant
+ Integer values VT_I4
+ Real values VT_R8
+ Strings VT_BSTR
+ undef VT_ERROR (DISP_E_PARAMNOTFOUND)
+ Array reference VT_VARIANT | VT_ARRAY
+ Win32::OLE object VT_DISPATCH
+ Win32::OLE::Variant object Type of the Variant object
+
+What if your Perl value is a list of lists? Those can be irregularly
+shaped in Perl; that is, the subsidiary lists needn't have the same
+number of elements. In this case, the structure will be converted to a
+"rectangular" C<SAFEARRAY> of Variants, with unused slots set to
+C<VT_EMPTY>. Consider this Perl 2-D array:
+
+ [ ["Perl" ], # one element
+ [1, 3.1215, undef] # three elements
+ ]
+
+This will be translated to a 2 by 3 C<SAFEARRAY> that looks like this:
+
+ VT_BSTR("Perl") VT_EMPTY VT_EMPTY
+ VT_I4(1) VT_R8(3.1415) VT_ERROR(DISP_E_PARAMNOTFOUND)
+
+B<The Variant To Perl Transformation.> Automatic conversion from Variants
+to Perl values happens as follows:
+
+ Variant Perl value
+ VT_BOOL, VT_ERROR Integer
+ VT_UI1, VT_I2, VT_I4 Integer
+ VT_R4, VT_R8 Float value
+ VT_BSTR String
+ VT_DISPATCH Win32::OLE object
+
+B<The Win32::OLE::Variant module.> This module provides access to the
+Variant data type, which gives you more control over how these
+arguments to OLE methods are encoded. (This is rarely necessary if you
+have a good grasp of the default conversion rules.) A Variant object
+can be created with the C<< Win32::OLE::Variant->new >> method or the
+equivalent Variant() function:
+
+ use Win32::OLE::Variant;
+ my $var1 = Win32::OLE::Variant->new(VT_DATE, 'Jan 1,1970');
+ my $var2 = Variant(VT_BSTR, 'This is an Unicode string');
+
+Several methods let you inspect and manipulate Variant objects: The
+Type() and Value() methods return the variant type and value; the As()
+method returns the value after converting it to a different variant
+type; ChangeType() coerces the Variant into a different type; and
+Unicode() returns the value of a Variant object as an object of the
+Unicode::String class.
+
+These conversions are more interesting if they can be applied directly
+to the return value of an OLE method call without first mutilating the
+value with default conversions. This is possible with the following
+trick:
+
+ my $RetVal = Variant(VT_EMPTY, undef);
+ $Object->Dispatch($Method, $RetVal, @Arguments);
+
+Normally, you wouldn't call Dispatch() directly; it's executed
+implicitly by either AUTOLOAD() or Invoke(). If Dispatch() realizes
+that the return value is already a Win32::OLE::Variant object, the
+return value is not translated into a Perl representation but rather
+copied verbatim into the Variant object.
+
+Whenever a Win32::OLE::Variant object is used in a numeric or string
+context it is automatically converted into the corresponding format.
+
+ printf "Number: %f and String: %s\n",
+ $Var, $Var;
+
+This is equivalent to:
+
+ printf "Number: %f and String: %s\n",
+ $Var->As(VT_R8), $Var->As(VT_BSTR);
+
+For methods that modify their arguments, you need to use the C<VT_BYREF>
+flag. This lets you create number and string Variants that can be
+modified by OLE methods. Here, Corel's GetSize() method takes two
+integers and stores the C<x> and C<y> dimensions in them:
+
+ my $x = Variant( VT_I4 | VT_BYREF, 0);
+ my $y = Variant( VT_I4 | VT_BYREF, 0);
+ $Corel->GetSize($x, $y);
+
+C<VT_BYREF> support for other Variant types might appear in future
+releases of Win32::OLE.
+
+=head1 FURTHER INFORMATION
+
+=head2 DOCUMENTATION AND EXAMPLE CODE
+
+More information about the OLE modules can be found in the
+documentation bundled with Win32::OLE. The distribution also contains
+other code samples.
+
+The object model for Microsoft Office applications can be found in the
+Visual Basic Reference for Microsoft Access, Excel, Word, or
+PowerPoint. These help files are not installed by default, but they
+can be added later by rerunning F<setup.exe> and choosing I<custom
+setup>. The object model for Microsoft Outlook can be found on the
+Microsoft Office Developer Forum at:
+http://www.microsoft.com/OutlookDev/.
+
+Information about the LotusScript object model can be found at:
+http://www.lotus.com/products/lotusscript.nsf.
+
+=head2 OLE AUTOMATION ON OTHER PLATFORMS
+
+Microsoft also makes OLE technology available for the Mac. DCOM is
+already included in Windows NT 4.0 and can be downloaded for Windows
+95. MVS and some Unix systems can use EntireX to get OLE
+functionality; see
+http://www.softwareag.com/corporat/solutions/entirex/entirex.htm.
+
+=head1 COPYRIGHT
+
+Copyright 1998 I<The Perl Journal>. http://www.tpj.com
+
+This article originally appeared in I<The Perl Journal> #10. It
+appears courtesy of Jon Orwant and I<The Perl Journal>. This document
+may be distributed under the same terms as Perl itself.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm
new file mode 100644
index 0000000000..d95399c1e2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/TypeInfo.pm
@@ -0,0 +1,389 @@
+# This module is still experimental and intentionally undocumented.
+# If you don't know why it is here, then you should probably not use it.
+
+package Win32::OLE::TypeInfo;
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+use vars qw(@VT %TYPEFLAGS @TYPEKIND %IMPLTYPEFLAGS %PARAMFLAGS
+ %FUNCFLAGS @CALLCONV @FUNCKIND %INVOKEKIND %VARFLAGS
+ %LIBFLAGS @SYSKIND);
+
+use Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(
+ VT_EMPTY VT_NULL VT_I2 VT_I4 VT_R4 VT_R8 VT_CY VT_DATE
+ VT_BSTR VT_DISPATCH VT_ERROR VT_BOOL VT_VARIANT VT_UNKNOWN
+ VT_DECIMAL VT_I1 VT_UI1 VT_UI2 VT_UI4 VT_I8 VT_UI8 VT_INT
+ VT_UINT VT_VOID VT_HRESULT VT_PTR VT_SAFEARRAY VT_CARRAY
+ VT_USERDEFINED VT_LPSTR VT_LPWSTR VT_FILETIME VT_BLOB
+ VT_STREAM VT_STORAGE VT_STREAMED_OBJECT VT_STORED_OBJECT
+ VT_BLOB_OBJECT VT_CF VT_CLSID VT_VECTOR VT_ARRAY VT_BYREF
+ VT_RESERVED VT_ILLEGAL VT_ILLEGALMASKED VT_TYPEMASK
+
+ TYPEFLAG_FAPPOBJECT TYPEFLAG_FCANCREATE TYPEFLAG_FLICENSED
+ TYPEFLAG_FPREDECLID TYPEFLAG_FHIDDEN TYPEFLAG_FCONTROL
+ TYPEFLAG_FDUAL TYPEFLAG_FNONEXTENSIBLE TYPEFLAG_FOLEAUTOMATION
+ TYPEFLAG_FRESTRICTED TYPEFLAG_FAGGREGATABLE TYPEFLAG_FREPLACEABLE
+ TYPEFLAG_FDISPATCHABLE TYPEFLAG_FREVERSEBIND
+
+ TKIND_ENUM TKIND_RECORD TKIND_MODULE TKIND_INTERFACE TKIND_DISPATCH
+ TKIND_COCLASS TKIND_ALIAS TKIND_UNION TKIND_MAX
+
+ IMPLTYPEFLAG_FDEFAULT IMPLTYPEFLAG_FSOURCE IMPLTYPEFLAG_FRESTRICTED
+ IMPLTYPEFLAG_FDEFAULTVTABLE
+
+ PARAMFLAG_NONE PARAMFLAG_FIN PARAMFLAG_FOUT PARAMFLAG_FLCID
+ PARAMFLAG_FRETVAL PARAMFLAG_FOPT PARAMFLAG_FHASDEFAULT
+
+ FUNCFLAG_FRESTRICTED FUNCFLAG_FSOURCE FUNCFLAG_FBINDABLE
+ FUNCFLAG_FREQUESTEDIT FUNCFLAG_FDISPLAYBIND FUNCFLAG_FDEFAULTBIND
+ FUNCFLAG_FHIDDEN FUNCFLAG_FUSESGETLASTERROR FUNCFLAG_FDEFAULTCOLLELEM
+ FUNCFLAG_FUIDEFAULT FUNCFLAG_FNONBROWSABLE FUNCFLAG_FREPLACEABLE
+ FUNCFLAG_FIMMEDIATEBIND
+
+ CC_FASTCALL CC_CDECL CC_MSCPASCAL CC_PASCAL CC_MACPASCAL CC_STDCALL
+ CC_FPFASTCALL CC_SYSCALL CC_MPWCDECL CC_MPWPASCAL CC_MAX
+
+ INVOKE_FUNC INVOKE_PROPERTYGET INVOKE_PROPERTYPUT INVOKE_PROPERTYPUTREF
+
+ VARFLAG_FREADONLY VARFLAG_FSOURCE VARFLAG_FBINDABLE VARFLAG_FREQUESTEDIT
+ VARFLAG_FDISPLAYBIND VARFLAG_FDEFAULTBIND VARFLAG_FHIDDEN VARFLAG_FRESTRICTED
+ VARFLAG_FDEFAULTCOLLELEM VARFLAG_FUIDEFAULT VARFLAG_FNONBROWSABLE
+ VARFLAG_FREPLACEABLE VARFLAG_FIMMEDIATEBIND
+
+ LIBFLAG_FRESTRICTED LIBFLAG_FCONTROL LIBFLAG_FHIDDEN
+ SYS_WIN16 SYS_WIN32 SYS_MAC
+
+ FUNC_VIRTUAL FUNC_PUREVIRTUAL FUNC_NONVIRTUAL FUNC_STATIC FUNC_DISPATCH
+
+ @VT %TYPEFLAGS @TYPEKIND %IMPLTYPEFLAGS %PARAMFLAGS
+ %FUNCFLAGS @CALLCONV @FUNCKIND %INVOKEKIND %VARFLAGS %LIBFLAGS @SYSKIND
+);
+
+# Lib Flags
+# ---------
+
+sub LIBFLAG_FRESTRICTED () { 0x01; }
+sub LIBFLAG_FCONTROL () { 0x02; }
+sub LIBFLAG_FHIDDEN () { 0x04; }
+
+$LIBFLAGS{LIBFLAG_FRESTRICTED()} = LIBFLAG_FRESTRICTED;
+$LIBFLAGS{LIBFLAG_FCONTROL()} = LIBFLAG_FCONTROL;
+$LIBFLAGS{LIBFLAG_FHIDDEN()} = LIBFLAG_FHIDDEN;
+
+# Sys Kind
+# --------
+
+sub SYS_WIN16 () { 0; }
+sub SYS_WIN32 () { SYS_WIN16() + 1; }
+sub SYS_MAC () { SYS_WIN32() + 1; }
+
+$SYSKIND[SYS_WIN16] = 'SYS_WIN16';
+$SYSKIND[SYS_WIN32] = 'SYS_WIN32';
+$SYSKIND[SYS_MAC] = 'SYS_MAC';
+
+# Type Flags
+# ----------
+
+sub TYPEFLAG_FAPPOBJECT () { 0x1; }
+sub TYPEFLAG_FCANCREATE () { 0x2; }
+sub TYPEFLAG_FLICENSED () { 0x4; }
+sub TYPEFLAG_FPREDECLID () { 0x8; }
+sub TYPEFLAG_FHIDDEN () { 0x10; }
+sub TYPEFLAG_FCONTROL () { 0x20; }
+sub TYPEFLAG_FDUAL () { 0x40; }
+sub TYPEFLAG_FNONEXTENSIBLE () { 0x80; }
+sub TYPEFLAG_FOLEAUTOMATION () { 0x100; }
+sub TYPEFLAG_FRESTRICTED () { 0x200; }
+sub TYPEFLAG_FAGGREGATABLE () { 0x400; }
+sub TYPEFLAG_FREPLACEABLE () { 0x800; }
+sub TYPEFLAG_FDISPATCHABLE () { 0x1000; }
+sub TYPEFLAG_FREVERSEBIND () { 0x2000; }
+
+$TYPEFLAGS{TYPEFLAG_FAPPOBJECT()} = TYPEFLAG_FAPPOBJECT;
+$TYPEFLAGS{TYPEFLAG_FCANCREATE()} = TYPEFLAG_FCANCREATE;
+$TYPEFLAGS{TYPEFLAG_FLICENSED()} = TYPEFLAG_FLICENSED;
+$TYPEFLAGS{TYPEFLAG_FPREDECLID()} = TYPEFLAG_FPREDECLID;
+$TYPEFLAGS{TYPEFLAG_FHIDDEN()} = TYPEFLAG_FHIDDEN;
+$TYPEFLAGS{TYPEFLAG_FCONTROL()} = TYPEFLAG_FCONTROL;
+$TYPEFLAGS{TYPEFLAG_FDUAL()} = TYPEFLAG_FDUAL;
+$TYPEFLAGS{TYPEFLAG_FNONEXTENSIBLE()} = TYPEFLAG_FNONEXTENSIBLE;
+$TYPEFLAGS{TYPEFLAG_FOLEAUTOMATION()} = TYPEFLAG_FOLEAUTOMATION;
+$TYPEFLAGS{TYPEFLAG_FRESTRICTED()} = TYPEFLAG_FRESTRICTED;
+$TYPEFLAGS{TYPEFLAG_FAGGREGATABLE()} = TYPEFLAG_FAGGREGATABLE;
+$TYPEFLAGS{TYPEFLAG_FREPLACEABLE()} = TYPEFLAG_FREPLACEABLE;
+$TYPEFLAGS{TYPEFLAG_FDISPATCHABLE()} = TYPEFLAG_FDISPATCHABLE;
+$TYPEFLAGS{TYPEFLAG_FREVERSEBIND()} = TYPEFLAG_FREVERSEBIND;
+
+# Type Kind
+# ---------
+
+sub TKIND_ENUM () { 0; }
+sub TKIND_RECORD () { TKIND_ENUM() + 1; }
+sub TKIND_MODULE () { TKIND_RECORD() + 1; }
+sub TKIND_INTERFACE () { TKIND_MODULE() + 1; }
+sub TKIND_DISPATCH () { TKIND_INTERFACE() + 1; }
+sub TKIND_COCLASS () { TKIND_DISPATCH() + 1; }
+sub TKIND_ALIAS () { TKIND_COCLASS() + 1; }
+sub TKIND_UNION () { TKIND_ALIAS() + 1; }
+sub TKIND_MAX () { TKIND_UNION() + 1; }
+
+$TYPEKIND[TKIND_ENUM] = 'TKIND_ENUM';
+$TYPEKIND[TKIND_RECORD] = 'TKIND_RECORD';
+$TYPEKIND[TKIND_MODULE] = 'TKIND_MODULE';
+$TYPEKIND[TKIND_INTERFACE] = 'TKIND_INTERFACE';
+$TYPEKIND[TKIND_DISPATCH] = 'TKIND_DISPATCH';
+$TYPEKIND[TKIND_COCLASS] = 'TKIND_COCLASS';
+$TYPEKIND[TKIND_ALIAS] = 'TKIND_ALIAS';
+$TYPEKIND[TKIND_UNION] = 'TKIND_UNION';
+
+# Implemented Type Flags
+# ----------------------
+
+sub IMPLTYPEFLAG_FDEFAULT () { 0x1; }
+sub IMPLTYPEFLAG_FSOURCE () { 0x2; }
+sub IMPLTYPEFLAG_FRESTRICTED () { 0x4; }
+sub IMPLTYPEFLAG_FDEFAULTVTABLE () { 0x800; }
+
+$IMPLTYPEFLAGS{IMPLTYPEFLAG_FDEFAULT()} = IMPLTYPEFLAG_FDEFAULT;
+$IMPLTYPEFLAGS{IMPLTYPEFLAG_FSOURCE()} = IMPLTYPEFLAG_FSOURCE;
+$IMPLTYPEFLAGS{IMPLTYPEFLAG_FRESTRICTED()} = IMPLTYPEFLAG_FRESTRICTED;
+$IMPLTYPEFLAGS{IMPLTYPEFLAG_FDEFAULTVTABLE()} = IMPLTYPEFLAG_FDEFAULTVTABLE;
+
+# Parameter Flags
+# ---------------
+
+sub PARAMFLAG_NONE () { 0; }
+sub PARAMFLAG_FIN () { 0x1; }
+sub PARAMFLAG_FOUT () { 0x2; }
+sub PARAMFLAG_FLCID () { 0x4; }
+sub PARAMFLAG_FRETVAL () { 0x8; }
+sub PARAMFLAG_FOPT () { 0x10; }
+sub PARAMFLAG_FHASDEFAULT () { 0x20; }
+
+$PARAMFLAGS{PARAMFLAG_NONE()} = PARAMFLAG_NONE;
+$PARAMFLAGS{PARAMFLAG_FIN()} = PARAMFLAG_FIN;
+$PARAMFLAGS{PARAMFLAG_FOUT()} = PARAMFLAG_FOUT;
+$PARAMFLAGS{PARAMFLAG_FLCID()} = PARAMFLAG_FLCID;
+$PARAMFLAGS{PARAMFLAG_FRETVAL()} = PARAMFLAG_FRETVAL;
+$PARAMFLAGS{PARAMFLAG_FOPT()} = PARAMFLAG_FOPT;
+$PARAMFLAGS{PARAMFLAG_FHASDEFAULT()} = PARAMFLAG_FHASDEFAULT;
+
+# Function Flags
+# --------------
+
+sub FUNCFLAG_FRESTRICTED () { 0x1; }
+sub FUNCFLAG_FSOURCE () { 0x2; }
+sub FUNCFLAG_FBINDABLE () { 0x4; }
+sub FUNCFLAG_FREQUESTEDIT () { 0x8; }
+sub FUNCFLAG_FDISPLAYBIND () { 0x10; }
+sub FUNCFLAG_FDEFAULTBIND () { 0x20; }
+sub FUNCFLAG_FHIDDEN () { 0x40; }
+sub FUNCFLAG_FUSESGETLASTERROR () { 0x80; }
+sub FUNCFLAG_FDEFAULTCOLLELEM () { 0x100; }
+sub FUNCFLAG_FUIDEFAULT () { 0x200; }
+sub FUNCFLAG_FNONBROWSABLE () { 0x400; }
+sub FUNCFLAG_FREPLACEABLE () { 0x800; }
+sub FUNCFLAG_FIMMEDIATEBIND () { 0x1000; }
+
+$FUNCFLAGS{FUNCFLAG_FRESTRICTED()} = FUNCFLAG_FRESTRICTED;
+$FUNCFLAGS{FUNCFLAG_FSOURCE()} = FUNCFLAG_FSOURCE;
+$FUNCFLAGS{FUNCFLAG_FBINDABLE()} = FUNCFLAG_FBINDABLE;
+$FUNCFLAGS{FUNCFLAG_FREQUESTEDIT()} = FUNCFLAG_FREQUESTEDIT;
+$FUNCFLAGS{FUNCFLAG_FDISPLAYBIND()} = FUNCFLAG_FDISPLAYBIND;
+$FUNCFLAGS{FUNCFLAG_FDEFAULTBIND()} = FUNCFLAG_FDEFAULTBIND;
+$FUNCFLAGS{FUNCFLAG_FHIDDEN()} = FUNCFLAG_FHIDDEN;
+$FUNCFLAGS{FUNCFLAG_FUSESGETLASTERROR()} = FUNCFLAG_FUSESGETLASTERROR;
+$FUNCFLAGS{FUNCFLAG_FDEFAULTCOLLELEM()} = FUNCFLAG_FDEFAULTCOLLELEM;
+$FUNCFLAGS{FUNCFLAG_FUIDEFAULT()} = FUNCFLAG_FUIDEFAULT;
+$FUNCFLAGS{FUNCFLAG_FNONBROWSABLE()} = FUNCFLAG_FNONBROWSABLE;
+$FUNCFLAGS{FUNCFLAG_FREPLACEABLE()} = FUNCFLAG_FREPLACEABLE;
+$FUNCFLAGS{FUNCFLAG_FIMMEDIATEBIND()} = FUNCFLAG_FIMMEDIATEBIND;
+
+# Calling conventions
+# -------------------
+
+sub CC_FASTCALL () { 0; }
+sub CC_CDECL () { 1; }
+sub CC_MSCPASCAL () { CC_CDECL() + 1; }
+sub CC_PASCAL () { CC_MSCPASCAL; }
+sub CC_MACPASCAL () { CC_PASCAL() + 1; }
+sub CC_STDCALL () { CC_MACPASCAL() + 1; }
+sub CC_FPFASTCALL () { CC_STDCALL() + 1; }
+sub CC_SYSCALL () { CC_FPFASTCALL() + 1; }
+sub CC_MPWCDECL () { CC_SYSCALL() + 1; }
+sub CC_MPWPASCAL () { CC_MPWCDECL() + 1; }
+sub CC_MAX () { CC_MPWPASCAL() + 1; }
+
+$CALLCONV[CC_FASTCALL] = 'CC_FASTCALL';
+$CALLCONV[CC_CDECL] = 'CC_CDECL';
+$CALLCONV[CC_PASCAL] = 'CC_PASCAL';
+$CALLCONV[CC_MACPASCAL] = 'CC_MACPASCAL';
+$CALLCONV[CC_STDCALL] = 'CC_STDCALL';
+$CALLCONV[CC_FPFASTCALL] = 'CC_FPFASTCALL';
+$CALLCONV[CC_SYSCALL] = 'CC_SYSCALL';
+$CALLCONV[CC_MPWCDECL] = 'CC_MPWCDECL';
+$CALLCONV[CC_MPWPASCAL] = 'CC_MPWPASCAL';
+
+# Function Kind
+# -------------
+
+sub FUNC_VIRTUAL () { 0; }
+sub FUNC_PUREVIRTUAL () { FUNC_VIRTUAL() + 1; }
+sub FUNC_NONVIRTUAL () { FUNC_PUREVIRTUAL() + 1; }
+sub FUNC_STATIC () { FUNC_NONVIRTUAL() + 1; }
+sub FUNC_DISPATCH () { FUNC_STATIC() + 1; }
+
+$FUNCKIND[FUNC_VIRTUAL] = 'FUNC_VIRTUAL';
+$FUNCKIND[FUNC_PUREVIRTUAL] = 'FUNC_PUREVIRTUAL';
+$FUNCKIND[FUNC_NONVIRTUAL] = 'FUNC_NONVIRTUAL';
+$FUNCKIND[FUNC_STATIC] = 'FUNC_STATIC';
+$FUNCKIND[FUNC_DISPATCH] = 'FUNC_DISPATCH';
+
+# Invoke Kind
+# -----------
+
+sub INVOKE_FUNC () { 1; }
+sub INVOKE_PROPERTYGET () { 2; }
+sub INVOKE_PROPERTYPUT () { 4; }
+sub INVOKE_PROPERTYPUTREF () { 8; }
+
+$INVOKEKIND{INVOKE_FUNC()} = INVOKE_FUNC;
+$INVOKEKIND{INVOKE_PROPERTYGET()} = INVOKE_PROPERTYGET;
+$INVOKEKIND{INVOKE_PROPERTYPUT()} = INVOKE_PROPERTYPUT;
+$INVOKEKIND{INVOKE_PROPERTYPUTREF()} = INVOKE_PROPERTYPUTREF;
+
+# Variable Flags
+# --------------
+
+sub VARFLAG_FREADONLY () { 0x1; }
+sub VARFLAG_FSOURCE () { 0x2; }
+sub VARFLAG_FBINDABLE () { 0x4; }
+sub VARFLAG_FREQUESTEDIT () { 0x8; }
+sub VARFLAG_FDISPLAYBIND () { 0x10; }
+sub VARFLAG_FDEFAULTBIND () { 0x20; }
+sub VARFLAG_FHIDDEN () { 0x40; }
+sub VARFLAG_FRESTRICTED () { 0x80; }
+sub VARFLAG_FDEFAULTCOLLELEM () { 0x100; }
+sub VARFLAG_FUIDEFAULT () { 0x200; }
+sub VARFLAG_FNONBROWSABLE () { 0x400; }
+sub VARFLAG_FREPLACEABLE () { 0x800; }
+sub VARFLAG_FIMMEDIATEBIND () { 0x1000; }
+
+$VARFLAGS{VARFLAG_FREADONLY()} = VARFLAG_FREADONLY;
+$VARFLAGS{VARFLAG_FSOURCE()} = VARFLAG_FSOURCE;
+$VARFLAGS{VARFLAG_FBINDABLE()} = VARFLAG_FBINDABLE;
+$VARFLAGS{VARFLAG_FREQUESTEDIT()} = VARFLAG_FREQUESTEDIT;
+$VARFLAGS{VARFLAG_FDISPLAYBIND()} = VARFLAG_FDISPLAYBIND;
+$VARFLAGS{VARFLAG_FDEFAULTBIND()} = VARFLAG_FDEFAULTBIND;
+$VARFLAGS{VARFLAG_FHIDDEN()} = VARFLAG_FHIDDEN;
+$VARFLAGS{VARFLAG_FRESTRICTED()} = VARFLAG_FRESTRICTED;
+$VARFLAGS{VARFLAG_FDEFAULTCOLLELEM()} = VARFLAG_FDEFAULTCOLLELEM;
+$VARFLAGS{VARFLAG_FUIDEFAULT()} = VARFLAG_FUIDEFAULT;
+$VARFLAGS{VARFLAG_FNONBROWSABLE()} = VARFLAG_FNONBROWSABLE;
+$VARFLAGS{VARFLAG_FREPLACEABLE()} = VARFLAG_FREPLACEABLE;
+$VARFLAGS{VARFLAG_FIMMEDIATEBIND()} = VARFLAG_FIMMEDIATEBIND;
+
+
+# Variant Types
+# -------------
+
+sub VT_EMPTY () { 0; }
+sub VT_NULL () { 1; }
+sub VT_I2 () { 2; }
+sub VT_I4 () { 3; }
+sub VT_R4 () { 4; }
+sub VT_R8 () { 5; }
+sub VT_CY () { 6; }
+sub VT_DATE () { 7; }
+sub VT_BSTR () { 8; }
+sub VT_DISPATCH () { 9; }
+sub VT_ERROR () { 10; }
+sub VT_BOOL () { 11; }
+sub VT_VARIANT () { 12; }
+sub VT_UNKNOWN () { 13; }
+sub VT_DECIMAL () { 14; }
+sub VT_I1 () { 16; }
+sub VT_UI1 () { 17; }
+sub VT_UI2 () { 18; }
+sub VT_UI4 () { 19; }
+sub VT_I8 () { 20; }
+sub VT_UI8 () { 21; }
+sub VT_INT () { 22; }
+sub VT_UINT () { 23; }
+sub VT_VOID () { 24; }
+sub VT_HRESULT () { 25; }
+sub VT_PTR () { 26; }
+sub VT_SAFEARRAY () { 27; }
+sub VT_CARRAY () { 28; }
+sub VT_USERDEFINED () { 29; }
+sub VT_LPSTR () { 30; }
+sub VT_LPWSTR () { 31; }
+sub VT_FILETIME () { 64; }
+sub VT_BLOB () { 65; }
+sub VT_STREAM () { 66; }
+sub VT_STORAGE () { 67; }
+sub VT_STREAMED_OBJECT () { 68; }
+sub VT_STORED_OBJECT () { 69; }
+sub VT_BLOB_OBJECT () { 70; }
+sub VT_CF () { 71; }
+sub VT_CLSID () { 72; }
+sub VT_VECTOR () { 0x1000; }
+sub VT_ARRAY () { 0x2000; }
+sub VT_BYREF () { 0x4000; }
+sub VT_RESERVED () { 0x8000; }
+sub VT_ILLEGAL () { 0xffff; }
+sub VT_ILLEGALMASKED () { 0xfff; }
+sub VT_TYPEMASK () { 0xfff; }
+
+$VT[VT_EMPTY] = 'VT_EMPTY';
+$VT[VT_NULL] = 'VT_NULL';
+$VT[VT_I2] = 'VT_I2';
+$VT[VT_I4] = 'VT_I4';
+$VT[VT_R4] = 'VT_R4';
+$VT[VT_R8] = 'VT_R8';
+$VT[VT_CY] = 'VT_CY';
+$VT[VT_DATE] = 'VT_DATE';
+$VT[VT_BSTR] = 'VT_BSTR';
+$VT[VT_DISPATCH] = 'VT_DISPATCH';
+$VT[VT_ERROR] = 'VT_ERROR';
+$VT[VT_BOOL] = 'VT_BOOL';
+$VT[VT_VARIANT] = 'VT_VARIANT';
+$VT[VT_UNKNOWN] = 'VT_UNKNOWN';
+$VT[VT_DECIMAL] = 'VT_DECIMAL';
+$VT[VT_I1] = 'VT_I1';
+$VT[VT_UI1] = 'VT_UI1';
+$VT[VT_UI2] = 'VT_UI2';
+$VT[VT_UI4] = 'VT_UI4';
+$VT[VT_I8] = 'VT_I8';
+$VT[VT_UI8] = 'VT_UI8';
+$VT[VT_INT] = 'VT_INT';
+$VT[VT_UINT] = 'VT_UINT';
+$VT[VT_VOID] = 'VT_VOID';
+$VT[VT_HRESULT] = 'VT_HRESULT';
+$VT[VT_PTR] = 'VT_PTR';
+$VT[VT_SAFEARRAY] = 'VT_SAFEARRAY';
+$VT[VT_CARRAY] = 'VT_CARRAY';
+$VT[VT_USERDEFINED] = 'VT_USERDEFINED';
+$VT[VT_LPSTR] = 'VT_LPSTR';
+$VT[VT_LPWSTR] = 'VT_LPWSTR';
+$VT[VT_FILETIME] = 'VT_FILETIME';
+$VT[VT_BLOB] = 'VT_BLOB';
+$VT[VT_STREAM] = 'VT_STREAM';
+$VT[VT_STORAGE] = 'VT_STORAGE';
+$VT[VT_STREAMED_OBJECT] = 'VT_STREAMED_OBJECT';
+$VT[VT_STORED_OBJECT] = 'VT_STORED_OBJECT';
+$VT[VT_BLOB_OBJECT] = 'VT_BLOB_OBJECT';
+$VT[VT_CF] = 'VT_CF';
+$VT[VT_CLSID] = 'VT_CLSID';
+$VT[VT_VECTOR] = 'VT_VECTOR';
+$VT[VT_ARRAY] = 'VT_ARRAY';
+$VT[VT_BYREF] = 'VT_BYREF';
+$VT[VT_RESERVED] = 'VT_RESERVED';
+$VT[VT_ILLEGAL] = 'VT_ILLEGAL';
+$VT[VT_ILLEGALMASKED] = 'VT_ILLEGALMASKED';
+$VT[VT_TYPEMASK] = 'VT_TYPEMASK';
+
+1;
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm
new file mode 100644
index 0000000000..38fc604820
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/OLE/Variant.pm
@@ -0,0 +1,577 @@
+# The documentation is at the __END__
+
+package Win32::OLE::Variant;
+require Win32::OLE; # Make sure the XS bootstrap has been called
+
+use strict;
+use vars qw(@ISA @EXPORT @EXPORT_OK);
+
+use Exporter;
+@ISA = qw(Exporter);
+
+@EXPORT = qw(
+ Variant
+ VT_EMPTY VT_NULL VT_I2 VT_I4 VT_R4 VT_R8 VT_CY VT_DATE VT_BSTR
+ VT_DISPATCH VT_ERROR VT_BOOL VT_VARIANT VT_UNKNOWN VT_DECIMAL VT_UI1
+ VT_ARRAY VT_BYREF
+ );
+
+@EXPORT_OK = qw(CP_ACP CP_OEMCP nothing nullstring);
+
+# Automation data types.
+sub VT_EMPTY {0;}
+sub VT_NULL {1;}
+sub VT_I2 {2;}
+sub VT_I4 {3;}
+sub VT_R4 {4;}
+sub VT_R8 {5;}
+sub VT_CY {6;}
+sub VT_DATE {7;}
+sub VT_BSTR {8;}
+sub VT_DISPATCH {9;}
+sub VT_ERROR {10;}
+sub VT_BOOL {11;}
+sub VT_VARIANT {12;}
+sub VT_UNKNOWN {13;}
+sub VT_DECIMAL {14;} # Officially not allowed in VARIANTARGs
+sub VT_UI1 {17;}
+
+sub VT_ARRAY {0x2000;}
+sub VT_BYREF {0x4000;}
+
+
+# For backward compatibility
+sub CP_ACP {0;} # ANSI codepage
+sub CP_OEMCP {1;} # OEM codepage
+
+use overload
+ # '+' => 'Add', '-' => 'Sub', '*' => 'Mul', '/' => 'Div',
+ '""' => sub {$_[0]->As(VT_BSTR)},
+ '0+' => sub {$_[0]->As(VT_R8)},
+ fallback => 1;
+
+sub Variant {
+ return Win32::OLE::Variant->new(@_);
+}
+
+sub nothing {
+ return Win32::OLE::Variant->new(VT_DISPATCH);
+}
+
+sub nullstring {
+ return Win32::OLE::Variant->new(VT_BSTR);
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+Win32::OLE::Variant - Create and modify OLE VARIANT variables
+
+=head1 SYNOPSIS
+
+ use Win32::OLE::Variant;
+ my $var = Variant(VT_DATE, 'Jan 1,1970');
+ $OleObject->{value} = $var;
+ $OleObject->Method($var);
+
+
+=head1 DESCRIPTION
+
+The IDispatch interface used by the Perl OLE module uses a universal
+argument type called VARIANT. This is basically an object containing
+a data type and the actual data value. The data type is specified by
+the VT_xxx constants.
+
+=head2 Functions
+
+=over 8
+
+=item nothing()
+
+The nothing() function returns an empty VT_DISPATCH variant. It can be
+used to clear an object reference stored in a property
+
+ use Win32::OLE::Variant qw(:DEFAULT nothing);
+ # ...
+ $object->{Property} = nothing;
+
+This has the same effect as the Visual Basic statement
+
+ Set object.Property = Nothing
+
+The nothing() function is B<not> exported by default.
+
+=item nullstring()
+
+The nullstring() function returns a VT_BSTR variant with a NULL string
+pointer. This is B<not> the same as a VT_BSTR variant with an empty
+string "". The nullstring() value is the same as the vbNullString
+constant in Visual Basic.
+
+The nullstring() function is B<not> exported by default.
+
+=item Variant(TYPE, DATA)
+
+This is just a function alias of the C<Win32::OLE::Variant->new()>
+method (see below). This function is exported by default.
+
+=back
+
+=head2 Methods
+
+=over 8
+
+=item new(TYPE, DATA)
+
+This method returns a Win32::OLE::Variant object of the specified
+TYPE that contains the given DATA. The Win32::OLE::Variant object
+can be used to specify data types other than IV, NV or PV (which are
+supported transparently). See L<Variants> below for details.
+
+For VT_EMPTY and VT_NULL variants, the DATA argument may be omitted.
+For all non-VT_ARRAY variants DATA specifies the initial value.
+
+To create a SAFEARRAY variant, you have to specify the VT_ARRAY flag in
+addition to the variant base type of the array elements. In this cases
+DATA must be a list specifying the dimensions of the array. Each element
+can be either an element count (indices 0 to count-1) or an array
+reference pointing to the lower and upper array bounds of this dimension:
+
+ my $Array = Win32::OLE::Variant->new(VT_ARRAY|VT_R8, [1,2], 2);
+
+This creates a 2-dimensional SAFEARRAY of doubles with 4 elements:
+(1,0), (1,1), (2,0) and (2,1).
+
+A special case is the creation of one-dimensional VT_UI1 arrays with
+a string DATA argument:
+
+ my $String = Variant(VT_ARRAY|VT_UI1, "String");
+
+This creates a 6 element character array initialized to "String". For
+backward compatibility VT_UI1 with a string initializer automatically
+implies VT_ARRAY. The next line is equivalent to the previous example:
+
+ my $String = Variant(VT_UI1, "String");
+
+If you really need a single character VT_UI1 variant, you have to create
+it using a numeric intializer:
+
+ my $Char = Variant(VT_UI1, ord('A'));
+
+=item As(TYPE)
+
+C<As> converts the VARIANT to the new type before converting to a
+Perl value. This take the current LCID setting into account. For
+example a string might contain a ',' as the decimal point character.
+Using C<$variant->As(VT_R8)> will correctly return the floating
+point value.
+
+The underlying variant object is NOT changed by this method.
+
+=item ChangeType(TYPE)
+
+This method changes the type of the contained VARIANT in place. It
+returns the object itself, not the converted value.
+
+=item Copy([DIM])
+
+This method creates a copy of the object. If the original variant had
+the VT_BYREF bit set then the new object will contain a copy of the
+referenced data and not a reference to the same old data. The new
+object will not have the VT_BYREF bit set.
+
+ my $Var = Variant(VT_I4|VT_ARRAY|VT_BYREF, [1,5], 3);
+ my $Copy = $Var->Copy;
+
+The type of C<$Copy> is now VT_I4|VT_ARRAY and the value is a copy of
+the other SAFEARRAY. Changes to elements of C<$Var> will not be reflected
+in C<$Copy> and vice versa.
+
+The C<Copy> method can also be used to extract a single element of a
+VT_ARRAY | VT_VARIANT object. In this case the array indices must be
+specified as a list DIM:
+
+ my $Int = $Var->Copy(1, 2);
+
+C<$Int> is now a VT_I4 Variant object containing the value of element (1,2).
+
+=item Currency([FORMAT[, LCID]])
+
+This method converts the VARIANT value into a formatted currency string. The
+FORMAT can be either an integer constant or a hash reference. Valid constants
+are 0 and LOCALE_NOUSEROVERRIDE. You get the value of LOCALE_NOUSEROVERRIDE
+from the Win32::OLE::NLS module:
+
+ use Win32::OLE::NLS qw(:LOCALE);
+
+LOCALE_NOUSEROVERRIDE tells the method to use the system default currency
+format for the specified locale, disregarding any changes that might have
+been made through the control panel application.
+
+The hash reference could contain the following keys:
+
+ NumDigits number of fractional digits
+ LeadingZero whether to use leading zeroes in decimal fields
+ Grouping size of each group of digits to the left of the decimal
+ DecimalSep decimal separator string
+ ThousandSep thousand separator string
+ NegativeOrder see L<Win32::OLE::NLS/LOCALE_ICURRENCY>
+ PositiveOrder see L<Win32::OLE::NLS/LOCALE_INEGCURR>
+ CurrencySymbol currency symbol string
+
+For example:
+
+ use Win32::OLE::Variant;
+ use Win32::OLE::NLS qw(:DEFAULT :LANG :SUBLANG :DATE :TIME);
+ my $lcidGerman = MAKELCID(MAKELANGID(LANG_GERMAN, SUBLANG_NEUTRAL));
+ my $v = Variant(VT_CY, "-922337203685477.5808");
+ print $v->Currency({CurrencySymbol => "Tuits"}, $lcidGerman), "\n";
+
+will print:
+
+ -922.337.203.685.477,58 Tuits
+
+=item Date([FORMAT[, LCID]])
+
+Converts the VARIANT into a formatted date string. FORMAT can be either
+one of the following integer constants or a format string:
+
+ LOCALE_NOUSEROVERRIDE system default date format for this locale
+ DATE_SHORTDATE use the short date format (default)
+ DATE_LONGDATE use the long date format
+ DATE_YEARMONTH use the year/month format
+ DATE_USE_ALT_CALENDAR use the alternate calendar, if one exists
+ DATE_LTRREADING left-to-right reading order layout
+ DATE_RTLREADING right-to left reading order layout
+
+The constants are available from the Win32::OLE::NLS module:
+
+ use Win32::OLE::NLS qw(:LOCALE :DATE);
+
+The following elements can be used to construct a date format string.
+Characters must be specified exactly as given below (e.g. "dd" B<not> "DD").
+Spaces can be inserted anywhere between formatting codes, other verbatim
+text should be included in single quotes.
+
+ d day of month
+ dd day of month with leading zero for single-digit days
+ ddd day of week: three-letter abbreviation (LOCALE_SABBREVDAYNAME)
+ dddd day of week: full name (LOCALE_SDAYNAME)
+ M month
+ MM month with leading zero for single-digit months
+ MMM month: three-letter abbreviation (LOCALE_SABBREVMONTHNAME)
+ MMMM month: full name (LOCALE_SMONTHNAME)
+ y year as last two digits
+ yy year as last two digits with leading zero for years less than 10
+ yyyy year represented by full four digits
+ gg period/era string
+
+For example:
+
+ my $v = Variant(VT_DATE, "April 1 99");
+ print $v->Date(DATE_LONGDATE), "\n";
+ print $v->Date("ddd',' MMM dd yy"), "\n";
+
+will print:
+
+ Thursday, April 01, 1999
+ Thu, Apr 01 99
+
+=item Dim()
+
+Returns a list of array bounds for a VT_ARRAY variant. The list contains
+an array reference for each dimension of the variant's SAFEARRAY. This
+reference points to an array containing the lower and upper bounds for
+this dimension. For example:
+
+ my @Dim = $Var->Dim;
+
+Now C<@Dim> contains the following list: C<([1,5], [0,2])>.
+
+=item Get(DIM)
+
+For normal variants C<Get> returns the value of the variant, just like the
+C<Value> method. For VT_ARRAY variants C<Get> retrieves the value of a single
+array element. In this case C<DIM> must be a list of array indices. E.g.
+
+ my $Val = $Var->Get(2,0);
+
+As a special case for one dimensional VT_UI1|VT_ARRAY variants the C<Get>
+method without arguments returns the character array as a Perl string.
+
+ print $String->Get, "\n";
+
+=item IsNothing()
+
+Tests if the object is an empty VT_DISPATCH variant. See also nothing().
+
+=item IsNullString()
+
+Tests if the object is an empty VT_BSTR variant. See also nullstring().
+
+=item LastError()
+
+The use of the C<Win32::OLE::Variant->LastError()> method is deprecated.
+Please use the C<Win32::OLE->LastError()> class method instead.
+
+=item Number([FORMAT[, LCID]])
+
+This method converts the VARIANT value into a formatted number string. The
+FORMAT can be either an integer constant or a hash reference. Valid constants
+are 0 and LOCALE_NOUSEROVERRIDE. You get the value of LOCALE_NOUSEROVERRIDE
+from the Win32::OLE::NLS module:
+
+ use Win32::OLE::NLS qw(:LOCALE);
+
+LOCALE_NOUSEROVERRIDE tells the method to use the system default number
+format for the specified locale, disregarding any changes that might have
+been made through the control panel application.
+
+The hash reference could contain the following keys:
+
+ NumDigits number of fractional digits
+ LeadingZero whether to use leading zeroes in decimal fields
+ Grouping size of each group of digits to the left of the decimal
+ DecimalSep decimal separator string
+ ThousandSep thousand separator string
+ NegativeOrder see L<Win32::OLE::NLS/LOCALE_INEGNUMBER>
+
+=item Put(DIM, VALUE)
+
+The C<Put> method is used to assign a new value to a variant. The value will
+be coerced into the current type of the variant. E.g.:
+
+ my $Var = Variant(VT_I4, 42);
+ $Var->Put(3.1415);
+
+This changes the value of the variant to C<3> because the type is VT_I4.
+
+For VT_ARRAY type variants the indices for each dimension of the contained
+SAFEARRAY must be specified in front of the new value:
+
+ $Array->Put(1, 1, 2.7);
+
+It is also possible to assign values to *every* element of the SAFEARRAY at
+once using a single Put() method call:
+
+ $Array->Put([[1,2], [3,4]]);
+
+In this case the argument to Put() must be an array reference and the
+dimensions of the Perl list-of-lists must match the dimensions of the
+SAFEARRAY exactly.
+
+The are a few special cases for one-dimensional VT_UI1 arrays: The VALUE
+can be specified as a string instead of a number. This will set the selected
+character to the first character of the string or to '\0' if the string was
+empty:
+
+ my $String = Variant(VT_UI1|VT_ARRAY, "ABCDE");
+ $String->Put(1, "123");
+ $String->Put(3, ord('Z'));
+ $String->Put(4, '');
+
+This will set the value of C<$String> to C<"A1CZ\0">. If the index is omitted
+then the string is copied to the value completely. The string is truncated
+if it is longer than the size of the VT_UI1 array. The result will be padded
+with '\0's if the string is shorter:
+
+ $String->Put("String");
+
+Now C<$String> contains the value "Strin".
+
+C<Put> returns the Variant object itself so that multiple C<Put> calls can be
+chained together:
+
+ $Array->Put(0,0,$First_value)->Put(0,1,$Another_value);
+
+=item Time([FORMAT[, LCID]])
+
+Converts the VARIANT into a formatted time string. FORMAT can be either
+one of the following integer constants or a format string:
+
+ LOCALE_NOUSEROVERRIDE system default time format for this locale
+ TIME_NOMINUTESORSECONDS don't use minutes or seconds
+ TIME_NOSECONDS don't use seconds
+ TIME_NOTIMEMARKER don't use a time marker
+ TIME_FORCE24HOURFORMAT always use a 24-hour time format
+
+The constants are available from the Win32::OLE::NLS module:
+
+ use Win32::OLE::NLS qw(:LOCALE :TIME);
+
+The following elements can be used to construct a time format string.
+Characters must be specified exactly as given below (e.g. "dd" B<not> "DD").
+Spaces can be inserted anywhere between formatting codes, other verbatim
+text should be included in single quotes.
+
+ h hours; 12-hour clock
+ hh hours with leading zero for single-digit hours; 12-hour clock
+ H hours; 24-hour clock
+ HH hours with leading zero for single-digit hours; 24-hour clock
+ m minutes
+ mm minutes with leading zero for single-digit minutes
+ s seconds
+ ss seconds with leading zero for single-digit seconds
+ t one character time marker string, such as A or P
+ tt multicharacter time marker string, such as AM or PM
+
+For example:
+
+ my $v = Variant(VT_DATE, "April 1 99 2:23 pm");
+ print $v->Time, "\n";
+ print $v->Time(TIME_FORCE24HOURFORMAT|TIME_NOTIMEMARKER), "\n";
+ print $v->Time("hh.mm.ss tt"), "\n";
+
+will print:
+
+ 2:23:00 PM
+ 14:23:00
+ 02.23.00 PM
+
+=item Type()
+
+The C<Type> method returns the variant type of the contained VARIANT.
+
+=item Unicode()
+
+The C<Unicode> method returns a C<Unicode::String> object. This contains
+the BSTR value of the variant in network byte order. If the variant is
+not currently in VT_BSTR format then a VT_BSTR copy will be produced first.
+
+=item Value()
+
+The C<Value> method returns the value of the VARIANT as a Perl value. The
+conversion is performed in the same manner as all return values of
+Win32::OLE method calls are converted.
+
+=back
+
+=head2 Overloading
+
+The Win32::OLE::Variant package has overloaded the conversion to
+string and number formats. Therefore variant objects can be used in
+arithmetic and string operations without applying the C<Value>
+method first.
+
+=head2 Class Variables
+
+The Win32::OLE::Variant class used to have its own set of class variables
+like C<$CP>, C<$LCID> and C<$Warn>. In version 0.1003 and later of the
+Win32::OLE module these variables have been eliminated. Now the settings
+of Win32::OLE are used by the Win32::OLE::Variant module too. Please read
+the documentation of the C<Win32::OLE-&gt;Option> class method.
+
+
+=head2 Constants
+
+These constants are exported by default:
+
+ VT_EMPTY
+ VT_NULL
+ VT_I2
+ VT_I4
+ VT_R4
+ VT_R8
+ VT_CY
+ VT_DATE
+ VT_BSTR
+ VT_DISPATCH
+ VT_ERROR
+ VT_BOOL
+ VT_VARIANT
+ VT_UNKNOWN
+ VT_DECIMAL
+ VT_UI1
+
+ VT_ARRAY
+ VT_BYREF
+
+VT_DECIMAL is not on the official list of allowable OLE Automation
+datatypes. But even Microsoft ADO seems to sometimes return values
+of Recordset fields in VT_DECIMAL format.
+
+=head2 Variants
+
+A Variant is a data type that is used to pass data between OLE
+connections.
+
+The default behavior is to convert each perl scalar variable into
+an OLE Variant according to the internal perl representation.
+The following type correspondence holds:
+
+ C type Perl type OLE type
+ ------ --------- --------
+ int IV VT_I4
+ double NV VT_R8
+ char * PV VT_BSTR
+ void * ref to AV VT_ARRAY
+ ? undef VT_ERROR
+ ? Win32::OLE object VT_DISPATCH
+
+Note that VT_BSTR is a wide character or Unicode string. This presents a
+problem if you want to pass in binary data as a parameter as 0x00 is
+inserted between all the bytes in your data. The C<Variant()> method
+provides a solution to this. With Variants the script writer can specify
+the OLE variant type that the parameter should be converted to. Currently
+supported types are:
+
+ VT_UI1 unsigned char
+ VT_I2 signed int (2 bytes)
+ VT_I4 signed int (4 bytes)
+ VT_R4 float (4 bytes)
+ VT_R8 float (8 bytes)
+ VT_DATE OLE Date
+ VT_BSTR OLE String
+ VT_CY OLE Currency
+ VT_BOOL OLE Boolean
+
+When VT_DATE and VT_CY objects are created, the input parameter is treated
+as a Perl string type, which is then converted to VT_BSTR, and finally to
+VT_DATE of VT_CY using the C<VariantChangeType()> OLE API function.
+See L<Win32::OLE/EXAMPLES> for how these types can be used.
+
+=head2 Variant arrays
+
+A variant can not only contain a single value but also a multi-dimensional
+array of values (called a SAFEARRAY). In this case the VT_ARRAY flag must
+be added to the base variant type, e.g. C<VT_I4 | VT_ARRAY> for an array of
+integers. The VT_EMPTY and VT_NULL types are invalid for SAFEARRAYs. It
+is possible to create an array of variants: C<VT_VARIANT | VT_ARRAY>. In this
+case each element of the array can have a different type (including VT_EMPTY
+and VT_NULL). The elements of a VT_VARIANT SAFEARRAY cannot have either of the
+VT_ARRAY or VT_BYREF flags set.
+
+The lower and upper bounds for each dimension can be specified separately.
+They do not have to have all the same lower bound (unlike Perl's arrays).
+
+=head2 Variants by reference
+
+Some OLE servers expect parameters passed by reference so that they
+can be changed in the method call. This allows methods to easily
+return multiple values. There is preliminary support for this in
+the Win32::OLE::Variant module:
+
+ my $x = Variant(VT_I4|VT_BYREF, 0);
+ my $y = Variant(VT_I4|VT_BYREF, 0);
+ $Corel->GetSize($x, $y);
+ print "Size is $x by $y\n";
+
+After the C<GetSize> method call C<$x> and C<$y> will be set to
+the respective sizes. They will still be variants. In the print
+statement the overloading converts them to string representation
+automatically.
+
+VT_BYREF is now supported for all variant types (including SAFEARRAYs).
+It can also be used to pass an OLE object by reference:
+
+ my $Results = $App->CreateResultsObject;
+ $Object->Method(Variant(VT_DISPATCH|VT_BYREF, $Results));
+
+=head1 AUTHORS/COPYRIGHT
+
+This module is part of the Win32::OLE distribution.
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/Shortcut.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/Shortcut.pm
new file mode 100644
index 0000000000..f284678828
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/Shortcut.pm
@@ -0,0 +1,752 @@
+package Win32::Shortcut;
+#######################################################################
+#
+# Win32::Shortcut - Perl Module for Shell Link Interface
+# ^^^^^^^^^^^^^^^
+# This module creates an object oriented interface to the Win32
+# Shell Links (IShellLink interface).
+#
+#######################################################################
+
+$VERSION = "0.08";
+
+require Exporter;
+require DynaLoader;
+
+@ISA= qw( Exporter DynaLoader );
+@EXPORT = qw(
+ SW_SHOWMAXIMIZED
+ SW_SHOWMINNOACTIVE
+ SW_SHOWNORMAL
+);
+
+
+#######################################################################
+# This AUTOLOAD is used to 'autoload' constants from the constant()
+# XS function. If a constant is not found then control is passed
+# to the AUTOLOAD in AutoLoader.
+#
+
+sub AUTOLOAD {
+ my($constname);
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ #reset $! to zero to reset any current errors.
+ local $!;
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($!) {
+ my(undef, $file, $line) = caller;
+ die "Win32::Shortcut::$constname is not defined, used at $file line $line.";
+ }
+ eval "sub $AUTOLOAD { $val }";
+ goto &$AUTOLOAD;
+}
+
+
+#######################################################################
+# PUBLIC METHODS
+#
+
+#========
+sub new {
+#========
+ my($class, $file) = @_;
+ my($ilink, $ifile) = _Instance();
+ return unless $ilink && $ifile;
+
+ my $self = bless {
+ ilink => $ilink,
+ ifile => $ifile,
+ File => "",
+ Path => "",
+ Arguments => "",
+ WorkingDirectory => "",
+ Description => "",
+ ShowCmd => 0,
+ Hotkey => 0,
+ IconLocation => "",
+ IconNumber => 0,
+ };
+
+
+ if ($file) {
+ $self->{File} = $file;
+ $self->Load($file);
+ }
+
+ return $self;
+}
+
+#=========
+sub Load {
+#=========
+ my($self, $file) = @_;
+ return undef unless ref($self);
+
+ my $result = _Load($self->{'ilink'}, $self->{'ifile'}, $file);
+
+ if ($result) {
+
+ # fill the properties of $self
+ $self->{'File'} = $file;
+ $self->{'Path'} = _GetPath($self->{'ilink'}, $self->{'ifile'},0);
+ $self->{'ShortPath'} = _GetPath($self->{'ilink'}, $self->{'ifile'},1);
+ $self->{'Arguments'} = _GetArguments($self->{'ilink'}, $self->{'ifile'});
+ $self->{'WorkingDirectory'} = _GetWorkingDirectory($self->{'ilink'}, $self->{'ifile'});
+ $self->{'Description'} = _GetDescription($self->{'ilink'}, $self->{'ifile'});
+ $self->{'ShowCmd'} = _GetShowCmd($self->{'ilink'}, $self->{'ifile'});
+ $self->{'Hotkey'} = _GetHotkey($self->{'ilink'}, $self->{'ifile'});
+ ($self->{'IconLocation'},
+ $self->{'IconNumber'}) = _GetIconLocation($self->{'ilink'}, $self->{'ifile'});
+ }
+ return $result;
+}
+
+
+#========
+sub Set {
+#========
+ my($self, $path, $arguments, $dir, $description, $show, $hotkey,
+ $iconlocation, $iconnumber) = @_;
+ return undef unless ref($self);
+
+ $self->{'Path'} = $path;
+ $self->{'Arguments'} = $arguments;
+ $self->{'WorkingDirectory'} = $dir;
+ $self->{'Description'} = $description;
+ $self->{'ShowCmd'} = $show;
+ $self->{'Hotkey'} = $hotkey;
+ $self->{'IconLocation'} = $iconlocation;
+ $self->{'IconNumber'} = $iconnumber;
+ return 1;
+}
+
+
+#=========
+sub Save {
+#=========
+ my($self, $file) = @_;
+ return unless ref($self);
+
+ $file = $self->{'File'} unless $file;
+ return unless $file;
+
+ require Win32 unless defined &Win32::GetFullPathName;
+ $file = Win32::GetFullPathName($file);
+
+ _SetPath($self->{'ilink'}, $self->{'ifile'}, $self->{'Path'});
+ _SetArguments($self->{'ilink'}, $self->{'ifile'}, $self->{'Arguments'});
+ _SetWorkingDirectory($self->{'ilink'}, $self->{'ifile'}, $self->{'WorkingDirectory'});
+ _SetDescription($self->{'ilink'}, $self->{'ifile'}, $self->{'Description'});
+ _SetShowCmd($self->{'ilink'}, $self->{'ifile'}, $self->{'ShowCmd'});
+ _SetHotkey($self->{'ilink'}, $self->{'ifile'}, $self->{'Hotkey'});
+ _SetIconLocation($self->{'ilink'}, $self->{'ifile'},
+ $self->{'IconLocation'}, $self->{'IconNumber'});
+
+ my $result = _Save($self->{'ilink'}, $self->{'ifile'}, $file);
+ if ($result) {
+ $self->{'File'} = $file unless $self->{'File'};
+ }
+ return $result;
+}
+
+#============
+sub Resolve {
+#============
+ my($self, $flags) = @_;
+ return undef unless ref($self);
+ $flags = 1 unless defined($flags);
+ my $result = _Resolve($self->{'ilink'}, $self->{'ifile'}, $flags);
+ return $result;
+}
+
+
+#==========
+sub Close {
+#==========
+ my($self) = @_;
+ return undef unless ref($self);
+
+ my $result = _Release($self->{'ilink'}, $self->{'ifile'});
+ $self->{'released'} = 1;
+ return $result;
+}
+
+#=========
+sub Path {
+#=========
+ my($self, $value) = @_;
+ return undef unless ref($self);
+
+ if(not defined($value)) {
+ return $self->{'Path'};
+ } else {
+ $self->{'Path'} = $value;
+ }
+ return $self->{'Path'};
+}
+
+#==============
+sub ShortPath {
+#==============
+ my($self) = @_;
+ return undef unless ref($self);
+ return $self->{'ShortPath'};
+}
+
+#==============
+sub Arguments {
+#==============
+ my($self, $value) = @_;
+ return undef unless ref($self);
+
+ if(not defined($value)) {
+ return $self->{'Arguments'};
+ } else {
+ $self->{'Arguments'} = $value;
+ }
+ return $self->{'Arguments'};
+}
+
+#=====================
+sub WorkingDirectory {
+#=====================
+ my($self, $value) = @_;
+ return undef unless ref($self);
+
+ if(not defined($value)) {
+ return $self->{'WorkingDirectory'};
+ } else {
+ $self->{'WorkingDirectory'} = $value;
+ }
+ return $self->{'WorkingDirectory'};
+}
+
+
+#================
+sub Description {
+#================
+ my($self, $value) = @_;
+ return undef unless ref($self);
+
+ if(not defined($value)) {
+ return $self->{'Description'};
+ } else {
+ $self->{'Description'} = $value;
+ }
+ return $self->{'Description'};
+}
+
+#============
+sub ShowCmd {
+#============
+ my($self, $value) = @_;
+ return undef unless ref($self);
+
+ if(not defined($value)) {
+ return $self->{'ShowCmd'};
+ } else {
+ $self->{'ShowCmd'} = $value;
+ }
+ return $self->{'ShowCmd'};
+}
+
+#===========
+sub Hotkey {
+#===========
+ my($self, $value) = @_;
+ return undef unless ref($self);
+
+ if(not defined($value)) {
+ return $self->{'Hotkey'};
+ } else {
+ $self->{'Hotkey'} = $value;
+ }
+ return $self->{'Hotkey'};
+}
+
+#=================
+sub IconLocation {
+#=================
+ my($self, $value) = @_;
+ return undef unless ref($self);
+
+ if(not defined($value)) {
+ return $self->{'IconLocation'};
+ } else {
+ $self->{'IconLocation'} = $value;
+ }
+ return $self->{'IconLocation'};
+}
+
+#===============
+sub IconNumber {
+#===============
+ my($self, $value) = @_;
+ return undef unless ref($self);
+
+ if(not defined($value)) {
+ return $self->{'IconNumber'};
+ } else {
+ $self->{'IconNumber'} = $value;
+ }
+ return $self->{'IconNumber'};
+}
+
+#============
+sub Version {
+#============
+ # [dada] to get rid of the "used only once" warning...
+ return $VERSION;
+}
+
+
+#######################################################################
+# PRIVATE METHODS
+#
+
+#============
+sub DESTROY {
+#============
+ my($self) = @_;
+
+ if (not $self->{'released'}) {
+ _Release($self->{'ilink'}, $self->{'ifile'});
+ $self->{'released'} = 1;
+ }
+}
+
+bootstrap Win32::Shortcut;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Win32::Shortcut - Perl Module to deal with Windows Shortcuts
+
+=head1 SYNOPSIS
+
+This module implements the Win32 IShellLink Interface to allow
+management of shortcut files from Perl.
+
+ use Win32::Shortcut;
+
+ $LINK = Win32::Shortcut->new();
+ $LINK->{'Path'} = "C:\\Directory\\Target.exe";
+ $LINK->{'Description'} = "Target executable";
+ $LINK->Save("Target.lnk");
+ $LINK->Close();
+
+=head1 REFERENCE
+
+=head2 General Usage
+
+To use this module, first add the following line at the beginning of
+your script:
+
+ use Win32::Shortcut;
+
+Then, use this command to create a shortcut object:
+
+ $LINK = Win32::Shortcut->new();
+
+This function will create a C<$LINK> object on which you can apply the
+Methods and Properties explained later.
+
+The object is not yet a shortcut file; it is just the definition of a
+shortcut. Basically, you can do 2 things:
+
+=over
+
+=item 1. Load a shortcut file into the object.
+
+=item 2. Save the object into a shortcut file.
+
+=back
+
+For the rest, the object can be accessed as it were a normal
+associative array reference. It has the following keys (here referred
+as properties):
+
+ $LINK->{'File'}
+ $LINK->{'Path'} $LINK->Path()
+ $LINK->{'ShortPath'}
+ $LINK->{'WorkingDirectory'} $LINK->WorkingDirectory()
+ $LINK->{'Arguments'} $LINK->Arguments()
+ $LINK->{'Description'} $LINK->Description()
+ $LINK->{'ShowCmd'} $LINK->ShowCmd()
+ $LINK->{'Hotkey'} $LINK->Hotkey()
+ $LINK->{'IconLocation'} $LINK->IconLocation()
+ $LINK->{'IconNumber'} $LINK->IconNumber()
+
+Thus, assuming you have a shortcut file named C<test.lnk> in your
+current directory, this simple script will tell you where this shortcut
+points to:
+
+ use Win32::Shortcut;
+ $LINK = Win32::Shortcut->new();
+ $LINK->Load("test.lnk");
+ print "Shortcut to: $LINK->{'Path'} $LINK->{'Arguments'} \n";
+ $LINK->Close();
+
+But you can also modify its values:
+
+ use Win32::Shortcut;
+ $LINK = Win32::Shortcut->new();
+ $LINK->Load("test.lnk");
+ $LINK->{'Path'} =~ s/C:/D:/i; # move the target from C: to D:
+ $LINK->{'ShowCmd'} = SW_NORMAL; # runs in a normal window
+
+and then you can save your changes to the shortcut file with this
+command:
+
+ $LINK->Save();
+ $LINK->Close();
+
+or you can save it with another name, creating a new shortcut file:
+
+ $LINK->Save("test2.lnk");
+ $LINK->Close();
+
+Finally, you can create a completely new shortcut:
+
+ $LINK = Win32::Shortcut->new();
+ $LINK->{'Path'} = "C:\\PERL5\\BIN\\PERL.EXE";
+ $LINK->{'Arguments'} = "-v";
+ $LINK->{'WorkingDirectory'} = "C:\PERL5\\BIN";
+ $LINK->{'Description'} = "Prints out the version of Perl";
+ $LINK->{'ShowCmd'} = SW_SHOWMAXIMIZED;
+ $LINK->Save("Perl Version Info.lnk");
+ $LINK->Close();
+
+Note also that in the examples above the two lines:
+
+ $LINK = Win32::Shortcut->new();
+ $LINK->Load("test.lnk");
+
+can be collapsed to:
+
+ $LINK = Win32::Shortcut->new("test.lnk");
+
+
+=head2 Methods
+
+=over
+
+=item B<Close>
+
+Closes a shortcut object. Note that it is not "strictly" required to
+close the objects you created, since the Win32::Shortcut objects are
+automatically closed when the program ends (or when you somehow destroy
+such an object).
+
+Note also that a shortcut is not automatically saved when it is closed,
+even if you modified it. You have to call Save in order to apply
+modifications to a shortcut file.
+
+Example:
+
+ $LINK->Close();
+
+=item B<Load> I<file>
+
+Loads the content of the shortcut file named I<file> in a shortcut
+object and fill the properties of the object with its values. Will
+return B<undef> on errors, or a true value if everything was
+successful.
+
+Example:
+
+ $LINK->Load("test.lnk") or print "test.lnk not found!";
+
+ print join("\n", $LINK->Path,
+ $LINK->ShortPath,
+ $LINK->Arguments,
+ $LINK->WorkingDirectory,
+ $LINK->Description,
+ $LINK->ShowCmd,
+ $LINK->Hotkey,
+ $LINK->IconLocation,
+ $LINK->IconNumber);
+ }
+
+=item B<new Win32::Shortcut> I<[file]>
+
+Creates a new shortcut object. If a filename is passed in I<file>,
+automatically Loads this file also. Returns the object created or
+B<undef> on errors.
+
+Example:
+
+ $LINK = Win32::Shortcut->new();
+
+ $RegEdit = Win32::Shortcut->new("Registry Editor.lnk");
+ die "File not found" if not $RegEdit;
+
+=item B<Resolve> I<[flag]>
+
+Attempts to automatically resolve a shortcut and returns the resolved
+path, or B<undef> on errors; in case no resolution was made, the path
+is returned unchanged. Note that the path is automatically updated in
+the Path property of the shortcut.
+
+By default this method acts quietly, but if you pass a value of 0
+(zero) in the I<flag> parameter, it will eventually post a dialog box
+prompting the user for more information.
+
+Example:
+
+ # if the target doesn't exist...
+ if(! -f $LINK->Path) {
+ # save the actual target for comparison
+ $oldpath = $LINK->Path;
+
+ # try to resolve it (with dialog box)
+ $newpath = $LINK->Resolve(0);
+
+ die "Not resolved..." if $newpath == $oldpath;
+ }
+
+=item B<Save> I<[file]>
+
+Saves the content of the shortcut object into the file named I<file>.
+If I<file> is omitted, it is taken from the File property of the object
+(which, if not changed, is the name of the last Loaded file).
+
+If no file was loaded and the File property doesn't contain a valid
+filename, the method will return B<undef>, which will also be returned
+on errors. A true value will be returned if everything was successful.
+
+Example:
+
+ $LINK->Save();
+ $LINK->Save("Copy of " . $LINK->{'File'});
+
+=item B<Set> I<path, arguments, workingdirectory, description, showcmd,
+hotkey, iconlocation, iconnumber>
+
+Sets all the properties of the shortcut object with a single command.
+This method is supplied for convenience only, you can also set those
+values changing the values of the properties.
+
+Example:
+
+ $LINK->Set("C:\\PERL5\\BIN\\PERL.EXE",
+ "-v",
+ "C:\\PERL5\\BIN",
+ "Prints out the version of Perl",
+ SW_SHOWMAXIMIZED,
+ hex('0x0337'),
+ "C:\\WINDOWS\\SYSTEM\\COOL.DLL",
+ 1);
+
+ # it is the same of...
+ $LINK->Path("C:\\PERL5\\BIN\\PERL.EXE");
+ $LINK->Arguments("-v");
+ $LINK->WorkingDirectory("C:\\PERL5\\BIN");
+ $LINK->Description("Prints out the version of Perl");
+ $LINK->ShowCmd(SW_SHOWMAXIMIZED);
+ $LINK->Hotkey(hex('0x0337'));
+ $LINK->IconLocation("C:\\WINDOWS\\SYSTEM\\COOL.DLL");
+ $LINK->IconNumber(1);
+
+=back
+
+=head2 Properties
+
+The properties of a shortcut object can be accessed as:
+
+ $OBJECT->{'property'}
+
+Eg., assuming that you have created a shortcut object with:
+
+ $LINK=new Win32::Shortcut();
+
+you can for example see its description with:
+
+ print $LINK->{'Description'};
+
+You can of course also set it:
+
+ $LINK->{'Description'}="This is a description";
+
+From version 0.02, those properties have also a corresponding method
+(subroutine), so you can write the 2 lines above using this syntax too:
+
+ print $LINK->Description;
+ $LINK->Description("This is a description");
+
+The properties of a shortcut reflect the content of the Shortcut
+Properties Dialog Box, which can be obtained by clicking the third
+mouse button on a shortcut file in the Windows 95 (or NT 4.0) Explorer
+and choosing "Properties" (well, I hope you already knew :).
+
+The fields corresponding to the single properties are marked in B<bold>
+in the following list.
+
+=over
+
+=item B<Arguments>
+
+The arguments associated with the shell link object. They will be
+passed to the targeted program (see Path) when it gets executed. In
+fact, joined with Path, this parameter forms the "B<Target>" field of a
+Shortcut Properties Dialog Box.
+
+=item B<Description>
+
+An optional description given to the shortcut. Seems to be missing in
+the Shortcut Properties Dialog Box (not yet implemented?).
+
+=item B<File>
+
+The filename of the shortcut file opened with Load, and/or the filename
+under which the shortcut will be saved with Save (if the I<file>
+argument is not specified).
+
+=item B<Hotkey>
+
+The hotkey associated to the shortcut, in the form of a 2-byte number
+of which the first byte identifies the modifiers (Ctrl, Alt, Shift...
+but I didn't find out how it works) and the second is the ASCII code of
+the character key. Correspond to the "B<Shortcut key>" field of a
+Shortcut Properties Dialog Box.
+
+=item B<IconLocation>
+
+The file that contain the icon for the shortcut. Seems actually to
+always return nothing (YMMV, I hope...).
+
+=item B<IconNumber>
+
+The number of the icon for the shortcut in the file pointed by
+IconLocation, in case more that one icon is contained in that file (I
+suppose this, documentation isn't so clear at this point).
+
+=item B<Path>
+
+The target of the shortcut. This is (joined with Arguments) the content
+of the "B<Target>" field in a Shortcut Properties Dialog Box.
+
+=item B<ShortPath>
+
+Same as Path, but expressed in a DOS-readable format (8.3 characters
+filenames). It is available as read-only (well, you can change it, but
+it has no effect on the shortcut; change Path instead) once you Load a
+shortcut file.
+
+=item B<ShowCmd>
+
+The condition of the window in which the program will be executed (can
+be Normal, Minimized or Maximized). Correspond to the "B<Run>" field of
+a Shortcut Properties Dialog Box.
+
+Allowed values are:
+
+B<Value> B<Meaning> B<Constant>
+
+ 1 Normal Window SW_SHOWNORMAL
+ 3 Maximized SW_SHOWMAXIMIZED
+ 7 Minimized SW_SHOWMINNOACTIVE
+
+Any other value (theoretically should) result in a Normal Window
+display.
+
+=item B<WorkingDirectory>
+
+The directory in which the targeted program will be executed.
+Correspond to the "B<Start in>" field of a Shortcut Properties Dialog
+Box.
+
+=back
+
+=head2 Constants
+
+The following constants are exported in the main namespace of your
+script using Win32::Shortcut:
+
+=over
+
+=item * SW_SHOWNORMAL
+
+=item * SW_SHOWMAXIMIZED
+
+=item * SW_SHOWMINNOACTIVE
+
+=back
+
+Those constants are the allowed values for the ShowCmd property.
+
+
+
+=head1 VERSION HISTORY
+
+B<0.03 (07 Apr 1997)>
+
+=over
+
+=item * The PLL file now comes in 2 versions, one for Perl version
+5.001 (build 110) and one for Perl version 5.003 (build 300 and higher,
+EXCEPT 304).
+
+=item * Added an installation program which will automatically copy the
+right files in the right place.
+
+=back
+
+B<0.02 (21 Jan 1997)>
+
+=over
+
+=item * Added methods matching properties to reduce typing overhead
+(eg. Alt-123 and 125...).
+
+=back
+
+B<0.01 (15 Jan 1997)>
+
+=over
+
+=item *
+
+First public release.
+
+=item *
+
+Added "Set" and "Resolve" and the properties "Hotkey", "IconLocation"
+and "IconNumber".
+
+=back
+
+B<0.01a (10 Jan 1997)>
+
+=over
+
+=item *
+
+First implementation of the IShellLink interface (wow, it works!); can
+"Load", "Save", and modify properties of shortcut files.
+
+=back
+
+=head1 AUTHOR
+
+Aldo Calpini L<dada@perl.it>
+
+Distributed under the terms of Larry Wall's Artistic License.
+
+=head1 CREDITS
+
+Thanks to: Jesse Dougherty, Dave Roth, ActiveWare, and the
+Perl-Win32-Users community.
+
+=head1 DISCLAIMER
+
+I<This program is FREE; you can redistribute, modify, disassemble, or
+even reverse engineer this software at your will. Keep in mind,
+however, that NOTHING IS GUARANTEED to work and everything you do is AT
+YOUR OWN RISK - I will not take responsibility for any damage, loss of
+money and/or health that may arise from the use of this program!>
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/TieRegistry.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/TieRegistry.pm
new file mode 100644
index 0000000000..4cda39e0ce
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/TieRegistry.pm
@@ -0,0 +1,3803 @@
+package Win32::TieRegistry;
+
+# Win32/TieRegistry.pm -- Perl module to easily use a Registry
+# (on Win32 systems so far).
+# by Tye McQueen, tye@metronet.com, see http://www.metronet.com/~tye/.
+
+#
+# Skip to "=head" line for user documentation.
+#
+use 5.006;
+use strict;
+use Carp;
+use Tie::Hash ();
+
+use vars qw( $PACK $VERSION @ISA @EXPORT @EXPORT_OK );
+BEGIN {
+ $PACK = 'Win32::TieRegistry';
+ $VERSION = '0.30';
+ @ISA = 'Tie::Hash';
+}
+
+# Required other modules:
+use Win32API::Registry 0.24 qw( :KEY_ :HKEY_ :REG_ );
+
+#Optional other modules:
+use vars qw( $_NoMoreItems $_FileNotFound $_TooSmall $_MoreData $_SetDualVar );
+
+if ( eval { require Win32::WinError } ) {
+ $_NoMoreItems = Win32::WinError::constant("ERROR_NO_MORE_ITEMS",0);
+ $_FileNotFound = Win32::WinError::constant("ERROR_FILE_NOT_FOUND",0);
+ $_TooSmall = Win32::WinError::constant("ERROR_INSUFFICIENT_BUFFER",0);
+ $_MoreData = Win32::WinError::constant("ERROR_MORE_DATA",0);
+} else {
+ $_NoMoreItems = "^No more data";
+ $_FileNotFound = "cannot find the file";
+ $_TooSmall = " data area passed to ";
+ $_MoreData = "^more data is avail";
+}
+if ( $_SetDualVar = eval { require SetDualVar } ) {
+ import SetDualVar;
+}
+
+#Implementation details:
+# When opened:
+# HANDLE long; actual handle value
+# MACHINE string; name of remote machine ("" if local)
+# PATH list ref; machine-relative full path for this key:
+# ["LMachine","System","Disk"]
+# ["HKEY_LOCAL_MACHINE","System","Disk"]
+# DELIM char; delimiter used to separate subkeys (def="\\")
+# OS_DELIM char; always "\\" for Win32
+# ACCESS long; usually KEY_ALL_ACCESS, perhaps KEY_READ, etc.
+# ROOTS string; var name for "Lmachine"->HKEY_LOCAL_MACHINE map
+# FLAGS int; bits to control certain options
+# Often:
+# VALUES ref to list of value names (data/type never cached)
+# SUBKEYS ref to list of subkey names
+# SUBCLASSES ref to list of subkey classes
+# SUBTIMES ref to list of subkey write times
+# MEMBERS ref to list of subkey_name.DELIM's, DELIM.value_name's
+# MEMBHASH hash ref to with MEMBERS as keys and 1's as values
+# Once Key "Info" requested:
+# Class CntSubKeys CntValues MaxSubKeyLen MaxSubClassLen
+# MaxValNameLen MaxValDataLen SecurityLen LastWrite
+# If is tied to a hash and iterating over key values:
+# PREVIDX int; index of last MEMBERS element return
+# If is the key object returned by Load():
+# UNLOADME list ref; information about Load()ed key
+# If is a subkey of a "loaded" key other than the one returned by Load():
+# DEPENDON obj ref; object that can't be destroyed before us
+
+
+#Package-local variables:
+
+# Option flag bits:
+use vars qw(
+ $Flag_ArrVal $Flag_TieVal $Flag_DualTyp $Flag_DualBin
+ $Flag_FastDel $Flag_HexDWord $Flag_Split $Flag_FixNulls
+);
+BEGIN {
+ $Flag_ArrVal = 0x0001;
+ $Flag_TieVal = 0x0002;
+ $Flag_FastDel = 0x0004;
+ $Flag_HexDWord = 0x0008;
+ $Flag_Split = 0x0010;
+ $Flag_DualTyp = 0x0020;
+ $Flag_DualBin = 0x0040;
+ $Flag_FixNulls = 0x0080;
+}
+
+use vars qw( $RegObj %_Roots %RegHash $Registry );
+
+# Short-hand for HKEY_* constants:
+%_Roots= (
+ "Classes" => HKEY_CLASSES_ROOT,
+ "CUser" => HKEY_CURRENT_USER,
+ "LMachine" => HKEY_LOCAL_MACHINE,
+ "Users" => HKEY_USERS,
+ "PerfData" => HKEY_PERFORMANCE_DATA, # Too picky to be useful
+ "CConfig" => HKEY_CURRENT_CONFIG,
+ "DynData" => HKEY_DYN_DATA, # Too picky to be useful
+);
+
+# Basic master Registry object:
+$RegObj= {};
+@$RegObj{qw( HANDLE MACHINE PATH DELIM OS_DELIM ACCESS FLAGS ROOTS )}= (
+ "NONE", "", [], "\\", "\\",
+ KEY_READ|KEY_WRITE, $Flag_HexDWord|$Flag_FixNulls, "${PACK}::_Roots" );
+$RegObj->{FLAGS} |= $Flag_DualTyp|$Flag_DualBin if $_SetDualVar;
+bless $RegObj;
+
+# Fill cache for master Registry object:
+@$RegObj{qw( VALUES SUBKEYS SUBCLASSES SUBTIMES )}= (
+ [], [ keys(%_Roots) ], [], [] );
+grep( s#$#$RegObj->{DELIM}#,
+ @{ $RegObj->{MEMBERS}= [ @{$RegObj->{SUBKEYS}} ] } );
+@$RegObj{qw( Class MaxSubKeyLen MaxSubClassLen MaxValNameLen
+ MaxValDataLen SecurityLen LastWrite CntSubKeys CntValues )}=
+ ( "", 0, 0, 0, 0, 0, 0, 0, 0 );
+
+# Create master Registry tied hash:
+$RegObj->Tie( \%RegHash );
+
+# Create master Registry combination object and tied hash reference:
+$Registry= \%RegHash;
+bless $Registry;
+
+
+# Preloaded methods go here.
+
+
+# Map option names to name of subroutine that controls that option:
+use vars qw( @_opt_subs %_opt_subs );
+@_opt_subs= qw( Delimiter ArrayValues TieValues SplitMultis DWordsToHex
+ FastDelete FixSzNulls DualTypes DualBinVals AllowLoad AllowSave );
+@_opt_subs{@_opt_subs}= @_opt_subs;
+
+sub import
+{
+ my $pkg = shift(@_);
+ my $level = $Exporter::ExportLevel;
+ my $expto = caller($level);
+ my @export = ();
+ my @consts = ();
+ my $registry = $Registry->Clone;
+ local( $_ );
+ while( @_ ) {
+ $_= shift(@_);
+ if( /^\$(\w+::)*\w+$/ ) {
+ push( @export, "ObjVar" ) if /^\$RegObj$/;
+ push( @export, $_ );
+ } elsif( /^\%(\w+::)*\w+$/ ) {
+ push( @export, $_ );
+ } elsif( /^[$%]/ ) {
+ croak "${PACK}->import: Invalid variable name ($_)";
+ } elsif( /^:/ || /^(H?KEY|REG)_/ ) {
+ push( @consts, $_ );
+ } elsif( ! @_ ) {
+ croak "${PACK}->import: Missing argument after option ($_)";
+ } elsif( exists $_opt_subs{$_} ) {
+ $_= $_opt_subs{$_};
+ $registry->$_( shift(@_) );
+ } elsif( /^TiedRef$/ ) {
+ $_= shift(@_);
+ if( ! ref($_) && /^(\$?)(\w+::)*\w+$/ ) {
+ $_= '$'.$_ unless '$' eq $1;
+ } elsif( "SCALAR" ne ref($_) ) {
+ croak "${PACK}->import: Invalid var after TiedRef ($_)";
+ }
+ push( @export, $_ );
+ } elsif( /^TiedHash$/ ) {
+ $_= shift(@_);
+ if( ! ref($_) && /^(\%?)(\w+::)*\w+$/ ) {
+ $_= '%'.$_ unless '%' eq $1;
+ } elsif( "HASH" ne ref($_) ) {
+ croak "${PACK}->import: Invalid var after TiedHash ($_)";
+ }
+ push( @export, $_ );
+ } elsif( /^ObjectRef$/ ) {
+ $_= shift(@_);
+ if( ! ref($_) && /^(\$?)(\w+::)*\w+$/ ) {
+ push( @export, "ObjVar" );
+ $_= '$'.$_ unless '$' eq $1;
+ } elsif( "SCALAR" eq ref($_) ) {
+ push( @export, "ObjRef" );
+ } else {
+ croak "${PACK}->import: Invalid var after ObjectRef ($_)";
+ }
+ push( @export, $_ );
+ } elsif( /^ExportLevel$/ ) {
+ $level= shift(@_);
+ $expto= caller($level);
+ } elsif( /^ExportTo$/ ) {
+ undef $level;
+ $expto= caller($level);
+ } else {
+ croak "${PACK}->import: Invalid option ($_)";
+ }
+ }
+ Win32API::Registry->export( $expto, @consts ) if @consts;
+ @export= ('$Registry') unless @export;
+ while( @export ) {
+ $_= shift( @export );
+ if( /^\$((?:\w+::)*)(\w+)$/ ) {
+ my( $pack, $sym )= ( $1, $2 );
+ $pack= $expto unless defined($pack) && "" ne $pack;
+ no strict 'refs';
+ *{"${pack}::$sym"}= \${"${pack}::$sym"};
+ ${"${pack}::$sym"}= $registry;
+ } elsif( /^\%((?:\w+::)*)(\w+)$/ ) {
+ my( $pack, $sym )= ( $1, $2 );
+ $pack= $expto unless defined($pack) && "" ne $pack;
+ no strict 'refs';
+ *{"${pack}::$sym"}= \%{"${pack}::$sym"};
+ $registry->Tie( \%{"${pack}::$sym"} );
+ } elsif( "SCALAR" eq ref($_) ) {
+ $$_= $registry;
+ } elsif( "HASH" eq ref($_) ) {
+ $registry->Tie( $_ );
+ } elsif( /^ObjVar$/ ) {
+ $_= shift( @_ );
+ /^\$((?:\w+::)*)(\w+)$/;
+ my( $pack, $sym )= ( $1, $2 );
+ $pack= $expto unless defined($pack) && "" ne $pack;
+ no strict 'refs';
+ *{"${pack}::$sym"}= \${"${pack}::$sym"};
+ ${"${pack}::$sym"}= $registry->ObjectRef;
+ } elsif( /^ObjRef$/ ) {
+ ${shift(@_)}= $registry->ObjectRef;
+ } else {
+ die "Impossible var to export ($_)";
+ }
+ }
+}
+
+
+use vars qw( @_new_Opts %_new_Opts );
+@_new_Opts= qw( ACCESS DELIM MACHINE DEPENDON );
+@_new_Opts{@_new_Opts}= (1) x @_new_Opts;
+
+sub _new
+{
+ my $this= shift( @_ );
+ $this= tied(%$this) if ref($this) && tied(%$this);
+ my $class= ref($this) || $this;
+ my $self= {};
+ my( $handle, $rpath, $opts )= @_;
+ if( @_ < 2 || "ARRAY" ne ref($rpath) || 3 < @_
+ || 3 == @_ && "HASH" ne ref($opts) ) {
+ croak "Usage: ${PACK}->_new( \$handle, \\\@path, {OPT=>VAL,...} );\n",
+ " options: @_new_Opts\nCalled";
+ }
+ @$self{qw( HANDLE PATH )}= ( $handle, $rpath );
+ @$self{qw( MACHINE ACCESS DELIM OS_DELIM ROOTS FLAGS )}=
+ ( $this->Machine, $this->Access, $this->Delimiter,
+ $this->OS_Delimiter, $this->_Roots, $this->_Flags );
+ if( ref($opts) ) {
+ my @err= grep( ! $_new_Opts{$_}, keys(%$opts) );
+ @err and croak "${PACK}->_new: Invalid options (@err)";
+ @$self{ keys(%$opts) }= values(%$opts);
+ }
+ bless $self, $class;
+ return $self;
+}
+
+
+sub _split
+{
+ my $self= shift( @_ );
+ $self= tied(%$self) if tied(%$self);
+ my $path= shift( @_ );
+ my $delim= @_ ? shift(@_) : $self->Delimiter;
+ my $list= [ split( /\Q$delim/, $path ) ];
+ return $list;
+}
+
+
+sub _rootKey
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $keyPath= shift(@_);
+ my $delim= @_ ? shift(@_) : $self->Delimiter;
+ my( $root, $subPath );
+ if( "ARRAY" eq ref($keyPath) ) {
+ $subPath= $keyPath;
+ } else {
+ $subPath= $self->_split( $keyPath, $delim );
+ }
+ $root= shift( @$subPath );
+ if( $root =~ /^HKEY_/ ) {
+ my $handle= Win32API::Registry::constant($root,0);
+ $handle or croak "Invalid HKEY_ constant ($root): $!";
+ return( $self->_new( $handle, [$root], {DELIM=>$delim} ),
+ $subPath );
+ } elsif( $root =~ /^([-+]|0x)?\d/ ) {
+ return( $self->_new( $root, [sprintf("0x%lX",$root)],
+ {DELIM=>$delim} ),
+ $subPath );
+ } else {
+ my $roots= $self->Roots;
+ if( $roots->{$root} ) {
+ return( $self->_new( $roots->{$root}, [$root], {DELIM=>$delim} ),
+ $subPath );
+ }
+ croak "No such root key ($root)";
+ }
+}
+
+
+sub _open
+{
+ my $this = shift(@_);
+ $this = tied(%$this) if ref($this) && tied(%$this);
+ my $subPath = shift(@_);
+ my $sam = @_ ? shift(@_) : $this->Access;
+ my $subKey = join( $this->OS_Delimiter, @$subPath );
+ my $handle = 0;
+ $this->RegOpenKeyEx( $subKey, 0, $sam, $handle ) or return ();
+ return $this->_new( $handle, [ @{$this->_Path}, @$subPath ],
+ { ACCESS=>$sam, ( defined($this->{UNLOADME}) ? ("DEPENDON",$this)
+ : defined($this->{DEPENDON}) ? ("DEPENDON",$this->{DEPENDON}) : () )
+ } );
+}
+
+
+sub ObjectRef
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ return $self;
+}
+
+
+sub _constant
+{
+ my( $name, $desc )= @_;
+ my $value= Win32API::Registry::constant( $name, 0 );
+ my $func= (caller(1))[3];
+ if( 0 == $value ) {
+ if( $! =~ /invalid/i ) {
+ croak "$func: Invalid $desc ($name)";
+ } elsif( 0 != $! ) {
+ croak "$func: \u$desc ($name) not support on this platform";
+ }
+ }
+ return $value;
+}
+
+
+sub _connect
+{
+ my $this= shift(@_);
+ $this= tied(%$this) if ref($this) && tied(%$this);
+ my $subPath= pop(@_);
+ $subPath= $this->_split( $subPath ) unless ref($subPath);
+ my $machine= @_ ? shift(@_) : shift(@$subPath);
+ my $handle= 0;
+ my( $temp )= $this->_rootKey( [@$subPath] );
+ $temp->RegConnectRegistry( $machine, $temp->Handle, $handle )
+ or return ();
+ my $self= $this->_new( $handle, [shift(@$subPath)], {MACHINE=>$machine} );
+ return( $self, $subPath );
+}
+
+
+use vars qw( @Connect_Opts %Connect_Opts );
+@Connect_Opts= qw(Access Delimiter);
+@Connect_Opts{@Connect_Opts}= (1) x @Connect_Opts;
+
+sub Connect
+{
+ my $this= shift(@_);
+ my $tied= ref($this) && tied(%$this);
+ $this= tied(%$this) if $tied;
+ my( $machine, $key, $opts )= @_;
+ my $delim= "";
+ my $sam;
+ my $subPath;
+ if( @_ < 2 || 3 < @_
+ || 3 == @_ && "HASH" ne ref($opts) ) {
+ croak "Usage: \$obj= ${PACK}->Connect(",
+ " \$Machine, \$subKey, { OPT=>VAL,... } );\n",
+ " options: @Connect_Opts\nCalled";
+ }
+ if( ref($opts) ) {
+ my @err= grep( ! $Connect_Opts{$_}, keys(%$opts) );
+ @err and croak "${PACK}->Connect: Invalid options (@err)";
+ }
+ $delim= "$opts->{Delimiter}" if defined($opts->{Delimiter});
+ $delim= $this->Delimiter if "" eq $delim;
+ $sam= defined($opts->{Access}) ? $opts->{Access} : $this->Access;
+ $sam= _constant($sam,"key access type") if $sam =~ /^KEY_/;
+ ( $this, $subPath )= $this->_connect( $machine, $key );
+ return () unless defined($this);
+ my $self= $this->_open( $subPath, $sam );
+ return () unless defined($self);
+ $self->Delimiter( $delim );
+ $self= $self->TiedRef if $tied;
+ return $self;
+}
+
+
+my @_newVirtual_keys= qw( MEMBERS VALUES SUBKEYS SUBTIMES SUBCLASSES
+ Class SecurityLen LastWrite CntValues CntSubKeys
+ MaxValNameLen MaxValDataLen MaxSubKeyLen MaxSubClassLen );
+
+sub _newVirtual
+{
+ my $self= shift(@_);
+ my( $rPath, $root, $opts )= @_;
+ my $new= $self->_new( "NONE", $rPath, $opts )
+ or return ();
+ @{$new}{@_newVirtual_keys}= @{$root->ObjectRef}{@_newVirtual_keys};
+ return $new;
+}
+
+
+#$key= new Win32::TieRegistry "LMachine/System/Disk";
+#$key= new Win32::TieRegistry "//Server1/LMachine/System/Disk";
+#Win32::TieRegistry->new( HKEY_LOCAL_MACHINE, {DELIM=>"/",ACCESS=>KEY_READ} );
+#Win32::TieRegistry->new( [ HKEY_LOCAL_MACHINE, ".../..." ], {DELIM=>$DELIM} );
+#$key->new( ... );
+
+use vars qw( @new_Opts %new_Opts );
+@new_Opts= qw(Access Delimiter);
+@new_Opts{@new_Opts}= (1) x @new_Opts;
+
+sub new
+{
+ my $this= shift( @_ );
+ $this= tied(%$this) if ref($this) && tied(%$this);
+ if( ! ref($this) ) {
+ no strict "refs";
+ my $self= ${"${this}::Registry"};
+ croak "${this}->new failed since ${PACK}::new sees that ",
+ "\$${this}::Registry is not an object."
+ if ! ref($self);
+ $this= $self->Clone;
+ }
+ my( $subKey, $opts )= @_;
+ my $delim= "";
+ my $dlen;
+ my $sam;
+ my $subPath;
+ if( @_ < 1 || 2 < @_
+ || 2 == @_ && "HASH" ne ref($opts) ) {
+ croak "Usage: \$obj= ${PACK}->new( \$subKey, { OPT=>VAL,... } );\n",
+ " options: @new_Opts\nCalled";
+ }
+ if( defined($opts) ) {
+ my @err= grep( ! $new_Opts{$_}, keys(%$opts) );
+ @err and die "${PACK}->new: Invalid options (@err)";
+ }
+ $delim= "$opts->{Delimiter}" if defined($opts->{Delimiter});
+ $delim= $this->Delimiter if "" eq $delim;
+ $dlen= length($delim);
+ $sam= defined($opts->{Access}) ? $opts->{Access} : $this->Access;
+ $sam= _constant($sam,"key access type") if $sam =~ /^KEY_/;
+ if( "ARRAY" eq ref($subKey) ) {
+ $subPath= $subKey;
+ if( "NONE" eq $this->Handle && @$subPath ) {
+ ( $this, $subPath )= $this->_rootKey( $subPath );
+ }
+ } elsif( $delim x 2 eq substr($subKey,0,2*$dlen) ) {
+ my $path= $this->_split( substr($subKey,2*$dlen), $delim );
+ my $mach= shift(@$path);
+ if( ! @$path ) {
+ return $this->_newVirtual( $path, $Registry,
+ {MACHINE=>$mach,DELIM=>$delim,ACCESS=>$sam} );
+ }
+ ( $this, $subPath )= $this->_connect( $mach, $path );
+ return () if ! defined($this);
+ if( 0 == @$subPath ) {
+ $this->Delimiter( $delim );
+ return $this;
+ }
+ } elsif( $delim eq substr($subKey,0,$dlen) ) {
+ ( $this, $subPath )= $this->_rootKey( substr($subKey,$dlen), $delim );
+ } elsif( "NONE" eq $this->Handle && "" ne $subKey ) {
+ my( $mach )= $this->Machine;
+ if( $mach ) {
+ ( $this, $subPath )= $this->_connect( $mach, $subKey );
+ } else {
+ ( $this, $subPath )= $this->_rootKey( $subKey, $delim );
+ }
+ } else {
+ $subPath= $this->_split( $subKey, $delim );
+ }
+ return () unless defined($this);
+ if( 0 == @$subPath && "NONE" eq $this->Handle ) {
+ return $this->_newVirtual( $this->_Path, $this,
+ { DELIM=>$delim, ACCESS=>$sam } );
+ }
+ my $self= $this->_open( $subPath, $sam );
+ return () unless defined($self);
+ $self->Delimiter( $delim );
+ return $self;
+}
+
+
+sub Open
+{
+ my $self= shift(@_);
+ my $tied= ref($self) && tied(%$self);
+ $self= tied(%$self) if $tied;
+ $self= $self->new( @_ );
+ $self= $self->TiedRef if defined($self) && $tied;
+ return $self;
+}
+
+
+sub Clone
+{
+ my $self= shift( @_ );
+ my $new= $self->Open("");
+ return $new;
+}
+
+
+{ my @flush;
+ sub Flush
+ {
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my( $flush )= @_;
+ @_ and croak "Usage: \$key->Flush( \$bFlush );";
+ return 0 if "NONE" eq $self->Handle;
+ @flush= qw( VALUES SUBKEYS SUBCLASSES SUBTIMES MEMBERS Class
+ CntSubKeys CntValues MaxSubKeyLen MaxSubClassLen
+ MaxValNameLen MaxValDataLen SecurityLen LastWrite PREVIDX )
+ unless @flush;
+ delete( @$self{@flush} );
+ if( defined($flush) && $flush ) {
+ return $self->RegFlushKey();
+ } else {
+ return 1;
+ }
+ }
+}
+
+
+sub _DualVal
+{
+ my( $hRef, $num )= @_;
+ if( $_SetDualVar && $$hRef{$num} ) {
+ &SetDualVar( $num, "$$hRef{$num}", 0+$num );
+ }
+ return $num;
+}
+
+
+use vars qw( @_RegDataTypes %_RegDataTypes );
+@_RegDataTypes= qw( REG_SZ REG_EXPAND_SZ REG_BINARY REG_LINK REG_MULTI_SZ
+ REG_DWORD_LITTLE_ENDIAN REG_DWORD_BIG_ENDIAN REG_DWORD
+ REG_RESOURCE_LIST REG_FULL_RESOURCE_DESCRIPTOR
+ REG_RESOURCE_REQUIREMENTS_LIST REG_NONE );
+# Make sure that REG_DWORD appears _after_ other REG_DWORD_*
+# items above and that REG_NONE appears _last_.
+foreach( @_RegDataTypes ) {
+ $_RegDataTypes{Win32API::Registry::constant($_,0)}= $_;
+}
+
+sub GetValue
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ 1 == @_ or croak "Usage: (\$data,\$type)= \$key->GetValue('ValName');";
+ my( $valName )= @_;
+ my( $valType, $valData, $dLen )= (0,"",0);
+ return () if "NONE" eq $self->Handle;
+ $self->RegQueryValueEx( $valName, [], $valType, $valData,
+ $dLen= ( defined($self->{MaxValDataLen}) ? $self->{MaxValDataLen} : 0 )
+ ) or return ();
+ if( REG_DWORD == $valType ) {
+ my $val= unpack("L",$valData);
+ $valData= sprintf "0x%08.8lX", $val if $self->DWordsToHex;
+ &SetDualVar( $valData, $valData, $val ) if $self->DualBinVals
+ } elsif( REG_BINARY == $valType && length($valData) <= 4 ) {
+ &SetDualVar( $valData, $valData, hex reverse unpack("h*",$valData) )
+ if $self->DualBinVals;
+ } elsif( ( REG_SZ == $valType || REG_EXPAND_SZ == $valType )
+ && $self->FixSzNulls ) {
+ substr($valData,-1)= "" if "\0" eq substr($valData,-1);
+ } elsif( REG_MULTI_SZ == $valType && $self->SplitMultis ) {
+ ## $valData =~ s/\0\0$//; # Why does this often fail??
+ substr($valData,-2)= "" if "\0\0" eq substr($valData,-2);
+ $valData= [ split( /\0/, $valData, -1 ) ]
+ }
+ if( ! wantarray ) {
+ return $valData;
+ } elsif( ! $self->DualTypes ) {
+ return( $valData, $valType );
+ } else {
+ return( $valData, _DualVal( \%_RegDataTypes, $valType ) );
+ }
+}
+
+
+sub _ErrNum
+{
+ # return $^E;
+ return Win32::GetLastError();
+}
+
+
+sub _ErrMsg
+{
+ # return $^E;
+ return Win32::FormatMessage( Win32::GetLastError() );
+}
+
+sub _Err
+{
+ my $err;
+ # return $^E;
+ return _ErrMsg if ! $_SetDualVar;
+ return &SetDualVar( $err, _ErrMsg, _ErrNum );
+}
+
+sub _NoMoreItems
+{
+ return
+ $_NoMoreItems =~ /^\d/
+ ? _ErrNum == $_NoMoreItems
+ : _ErrMsg =~ /$_NoMoreItems/io;
+}
+
+
+sub _FileNotFound
+{
+ return
+ $_FileNotFound =~ /^\d/
+ ? _ErrNum == $_FileNotFound
+ : _ErrMsg =~ /$_FileNotFound/io;
+}
+
+
+sub _TooSmall
+{
+ return
+ $_TooSmall =~ /^\d/
+ ? _ErrNum == $_TooSmall
+ : _ErrMsg =~ /$_TooSmall/io;
+}
+
+
+sub _MoreData
+{
+ return
+ $_MoreData =~ /^\d/
+ ? _ErrNum == $_MoreData
+ : _ErrMsg =~ /$_MoreData/io;
+}
+
+
+sub _enumValues
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my( @names )= ();
+ my $pos= 0;
+ my $name= "";
+ my $nlen= 1+$self->Information("MaxValNameLen");
+ while( $self->RegEnumValue($pos++,$name,my $nlen1=$nlen,[],[],[],[]) ) {
+ #RegEnumValue modifies $nlen1
+ push( @names, $name );
+ }
+ if( ! _NoMoreItems() ) {
+ return ();
+ }
+ $self->{VALUES}= \@names;
+ return 1;
+}
+
+
+sub ValueNames
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \@names= \$key->ValueNames;";
+ $self->_enumValues unless $self->{VALUES};
+ return @{$self->{VALUES}};
+}
+
+
+sub _enumSubKeys
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my( @subkeys, @classes, @times )= ();
+ my $pos= 0;
+ my( $subkey, $class, $time )= ("","","");
+ my( $namSiz, $clsSiz )= $self->Information(
+ qw( MaxSubKeyLen MaxSubClassLen ));
+ $namSiz++; $clsSiz++;
+ my $namSiz1 = $namSiz;
+ while( $self->RegEnumKeyEx(
+ $pos++, $subkey, $namSiz, [], $class, $clsSiz, $time ) ) {
+ push( @subkeys, $subkey );
+ push( @classes, $class );
+ push( @times, $time );
+ $namSiz = $namSiz1; #RegEnumKeyEx modifies $namSiz
+ }
+ if( ! _NoMoreItems() ) {
+ return ();
+ }
+ $self->{SUBKEYS}= \@subkeys;
+ $self->{SUBCLASSES}= \@classes;
+ $self->{SUBTIMES}= \@times;
+ return 1;
+}
+
+
+sub SubKeyNames
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \@names= \$key->SubKeyNames;";
+ $self->_enumSubKeys unless $self->{SUBKEYS};
+ return @{$self->{SUBKEYS}};
+}
+
+
+sub SubKeyClasses
+{
+ my $self= shift(@_);
+ @_ and croak "Usage: \@classes= \$key->SubKeyClasses;";
+ $self->_enumSubKeys unless $self->{SUBCLASSES};
+ return @{$self->{SUBCLASSES}};
+}
+
+
+sub SubKeyTimes
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \@times= \$key->SubKeyTimes;";
+ $self->_enumSubKeys unless $self->{SUBTIMES};
+ return @{$self->{SUBTIMES}};
+}
+
+
+sub _MemberNames
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \$arrayRef= \$key->_MemberNames;";
+ if( ! $self->{MEMBERS} ) {
+ $self->_enumValues unless $self->{VALUES};
+ $self->_enumSubKeys unless $self->{SUBKEYS};
+ my( @members )= ( map( $_.$self->{DELIM}, @{$self->{SUBKEYS}} ),
+ map( $self->{DELIM}.$_, @{$self->{VALUES}} ) );
+ $self->{MEMBERS}= \@members;
+ }
+ return $self->{MEMBERS};
+}
+
+
+sub _MembersHash
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \$hashRef= \$key->_MembersHash;";
+ if( ! $self->{MEMBHASH} ) {
+ my $aRef= $self->_MemberNames;
+ $self->{MEMBHASH}= {};
+ @{$self->{MEMBHASH}}{@$aRef}= (1) x @$aRef;
+ }
+ return $self->{MEMBHASH};
+}
+
+
+sub MemberNames
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \@members= \$key->MemberNames;";
+ return @{$self->_MemberNames};
+}
+
+
+sub Information
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my( $time, $nkeys, $nvals, $xsec, $xkey, $xcls, $xname, $xdata )=
+ ("",0,0,0,0,0,0,0);
+ my $clen= 8;
+ if( ! $self->RegQueryInfoKey( [], [], $nkeys, $xkey, $xcls,
+ $nvals, $xname, $xdata, $xsec, $time ) ) {
+ return ();
+ }
+ if( defined($self->{Class}) ) {
+ $clen= length($self->{Class});
+ } else {
+ $self->{Class}= "";
+ }
+ while( ! $self->RegQueryInfoKey( $self->{Class}, $clen,
+ [],[],[],[],[],[],[],[],[])
+ && _MoreData ) {
+ $clen *= 2;
+ }
+ my( %info );
+ @info{ qw( LastWrite CntSubKeys CntValues SecurityLen
+ MaxValDataLen MaxSubKeyLen MaxSubClassLen MaxValNameLen )
+ }= ( $time, $nkeys, $nvals, $xsec,
+ $xdata, $xkey, $xcls, $xname );
+ if( @_ ) {
+ my( %check );
+ @check{keys(%info)}= keys(%info);
+ my( @err )= grep( ! $check{$_}, @_ );
+ if( @err ) {
+ croak "${PACK}::Information- Invalid info requested (@err)";
+ }
+ return @info{@_};
+ } else {
+ return %info;
+ }
+}
+
+
+sub Delimiter
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ $self= $RegObj unless ref($self);
+ my( $oldDelim )= $self->{DELIM};
+ if( 1 == @_ && "" ne "$_[0]" ) {
+ delete $self->{MEMBERS};
+ delete $self->{MEMBHASH};
+ $self->{DELIM}= "$_[0]";
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldDelim= \$key->Delimiter(\$newDelim);";
+ }
+ return $oldDelim;
+}
+
+
+sub Handle
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \$handle= \$key->Handle;";
+ $self= $RegObj unless ref($self);
+ return $self->{HANDLE};
+}
+
+
+sub Path
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \$path= \$key->Path;";
+ my $delim= $self->{DELIM};
+ $self= $RegObj unless ref($self);
+ if( "" eq $self->{MACHINE} ) {
+ return( $delim . join( $delim, @{$self->{PATH}} ) . $delim );
+ } else {
+ return( $delim x 2
+ . join( $delim, $self->{MACHINE}, @{$self->{PATH}} )
+ . $delim );
+ }
+}
+
+
+sub _Path
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \$arrRef= \$key->_Path;";
+ $self= $RegObj unless ref($self);
+ return $self->{PATH};
+}
+
+
+sub Machine
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \$machine= \$key->Machine;";
+ $self= $RegObj unless ref($self);
+ return $self->{MACHINE};
+}
+
+
+sub Access
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \$access= \$key->Access;";
+ $self= $RegObj unless ref($self);
+ return $self->{ACCESS};
+}
+
+
+sub OS_Delimiter
+{
+ my $self= shift(@_);
+ @_ and croak "Usage: \$backslash= \$key->OS_Delimiter;";
+ return $self->{OS_DELIM};
+}
+
+
+sub _Roots
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if ref($self) && tied(%$self);
+ @_ and croak "Usage: \$varName= \$key->_Roots;";
+ $self= $RegObj unless ref($self);
+ return $self->{ROOTS};
+}
+
+
+sub Roots
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if ref($self) && tied(%$self);
+ @_ and croak "Usage: \$hashRef= \$key->Roots;";
+ $self= $RegObj unless ref($self);
+ return eval "\\%$self->{ROOTS}";
+}
+
+
+sub TIEHASH
+{
+ my( $this )= shift(@_);
+ $this= tied(%$this) if ref($this) && tied(%$this);
+ my( $key )= @_;
+ if( 1 == @_ && ref($key) && "$key" =~ /=/ ) {
+ return $key; # $key is already an object (blessed reference).
+ }
+ return $this->new( @_ );
+}
+
+
+sub Tie
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my( $hRef )= @_;
+ if( 1 != @_ || ! ref($hRef) || "$hRef" !~ /(^|=)HASH\(/ ) {
+ croak "Usage: \$key->Tie(\\\%hash);";
+ }
+ return tie %$hRef, ref($self), $self;
+}
+
+
+sub TiedRef
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $hRef= @_ ? shift(@_) : {};
+ return () if ! defined($self);
+ $self->Tie($hRef);
+ bless $hRef, ref($self);
+ return $hRef;
+}
+
+
+sub _Flags
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlags= $self->{FLAGS};
+ if( 1 == @_ ) {
+ $self->{FLAGS}= shift(@_);
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBits= \$key->_Flags(\$newBits);";
+ }
+ return $oldFlags;
+}
+
+
+sub ArrayValues
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlag= $Flag_ArrVal == ( $Flag_ArrVal & $self->{FLAGS} );
+ if( 1 == @_ ) {
+ my $bool= shift(@_);
+ if( $bool ) {
+ $self->{FLAGS} |= $Flag_ArrVal;
+ } else {
+ $self->{FLAGS} &= ~( $Flag_ArrVal | $Flag_TieVal );
+ }
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBool= \$key->ArrayValues(\$newBool);";
+ }
+ return $oldFlag;
+}
+
+
+sub TieValues
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlag= $Flag_TieVal == ( $Flag_TieVal & $self->{FLAGS} );
+ if( 1 == @_ ) {
+ my $bool= shift(@_);
+ if( $bool ) {
+ croak "${PACK}->TieValues cannot be enabled with this version";
+ $self->{FLAGS} |= $Flag_TieVal;
+ } else {
+ $self->{FLAGS} &= ~$Flag_TieVal;
+ }
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBool= \$key->TieValues(\$newBool);";
+ }
+ return $oldFlag;
+}
+
+
+sub FastDelete
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlag= $Flag_FastDel == ( $Flag_FastDel & $self->{FLAGS} );
+ if( 1 == @_ ) {
+ my $bool= shift(@_);
+ if( $bool ) {
+ $self->{FLAGS} |= $Flag_FastDel;
+ } else {
+ $self->{FLAGS} &= ~$Flag_FastDel;
+ }
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBool= \$key->FastDelete(\$newBool);";
+ }
+ return $oldFlag;
+}
+
+
+sub SplitMultis
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlag= $Flag_Split == ( $Flag_Split & $self->{FLAGS} );
+ if( 1 == @_ ) {
+ my $bool= shift(@_);
+ if( $bool ) {
+ $self->{FLAGS} |= $Flag_Split;
+ } else {
+ $self->{FLAGS} &= ~$Flag_Split;
+ }
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBool= \$key->SplitMultis(\$newBool);";
+ }
+ return $oldFlag;
+}
+
+
+sub DWordsToHex
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlag= $Flag_HexDWord == ( $Flag_HexDWord & $self->{FLAGS} );
+ if( 1 == @_ ) {
+ my $bool= shift(@_);
+ if( $bool ) {
+ $self->{FLAGS} |= $Flag_HexDWord;
+ } else {
+ $self->{FLAGS} &= ~$Flag_HexDWord;
+ }
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBool= \$key->DWordsToHex(\$newBool);";
+ }
+ return $oldFlag;
+}
+
+
+sub FixSzNulls
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlag= $Flag_FixNulls == ( $Flag_FixNulls & $self->{FLAGS} );
+ if( 1 == @_ ) {
+ my $bool= shift(@_);
+ if( $bool ) {
+ $self->{FLAGS} |= $Flag_FixNulls;
+ } else {
+ $self->{FLAGS} &= ~$Flag_FixNulls;
+ }
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBool= \$key->FixSzNulls(\$newBool);";
+ }
+ return $oldFlag;
+}
+
+
+sub DualTypes
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlag= $Flag_DualTyp == ( $Flag_DualTyp & $self->{FLAGS} );
+ if( 1 == @_ ) {
+ my $bool= shift(@_);
+ if( $bool ) {
+ croak "${PACK}->DualTypes cannot be enabled since ",
+ "SetDualVar module not installed"
+ unless $_SetDualVar;
+ $self->{FLAGS} |= $Flag_DualTyp;
+ } else {
+ $self->{FLAGS} &= ~$Flag_DualTyp;
+ }
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBool= \$key->DualTypes(\$newBool);";
+ }
+ return $oldFlag;
+}
+
+
+sub DualBinVals
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $oldFlag= $Flag_DualBin == ( $Flag_DualBin & $self->{FLAGS} );
+ if( 1 == @_ ) {
+ my $bool= shift(@_);
+ if( $bool ) {
+ croak "${PACK}->DualBinVals cannot be enabled since ",
+ "SetDualVar module not installed"
+ unless $_SetDualVar;
+ $self->{FLAGS} |= $Flag_DualBin;
+ } else {
+ $self->{FLAGS} &= ~$Flag_DualBin;
+ }
+ } elsif( 0 != @_ ) {
+ croak "Usage: \$oldBool= \$key->DualBinVals(\$newBool);";
+ }
+ return $oldFlag;
+}
+
+
+sub GetOptions
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my( $opt, $meth );
+ if( ! @_ || 1 == @_ && "HASH" eq ref($_[0]) ) {
+ my $href= @_ ? $_[0] : {};
+ foreach $opt ( grep !/^Allow/, @_opt_subs ) {
+ $meth= $_opt_subs{$opt};
+ $href->{$opt}= $self->$meth();
+ }
+ return @_ ? $self : $href;
+ }
+ my @old;
+ foreach $opt ( @_ ) {
+ $meth= $_opt_subs{$opt};
+ if( defined $meth ) {
+ if( $opt eq "AllowLoad" || $opt eq "AllowSave" ) {
+ croak "${PACK}->GetOptions: Getting current setting of $opt ",
+ "not supported in this release";
+ }
+ push( @old, $self->$meth() );
+ } else {
+ croak "${PACK}->GetOptions: Invalid option ($opt) ",
+ "not one of ( ", join(" ",grep !/^Allow/, @_opt_subs), " )";
+ }
+ }
+ return wantarray ? @old : $old[-1];
+}
+
+
+sub SetOptions
+{
+ my $self= shift(@_);
+ # Don't get object if hash ref so "ref" returns original ref.
+ my( $opt, $meth, @old );
+ while( @_ ) {
+ $opt= shift(@_);
+ $meth= $_opt_subs{$opt};
+ if( ! @_ ) {
+ croak "${PACK}->SetOptions: Option value missing ",
+ "after option name ($opt)";
+ } elsif( defined $meth ) {
+ push( @old, $self->$meth( shift(@_) ) );
+ } elsif( $opt eq substr("reference",0,length($opt)) ) {
+ shift(@_) if @_;
+ push( @old, $self );
+ } else {
+ croak "${PACK}->SetOptions: Invalid option ($opt) ",
+ "not one of ( @_opt_subs )";
+ }
+ }
+ return wantarray ? @old : $old[-1];
+}
+
+
+sub _parseTiedEnt
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $ent= shift(@_);
+ my $delim= shift(@_);
+ my $dlen= length( $delim );
+ my $parent= @_ ? shift(@_) : 0;
+ my $off;
+ if( $delim x 2 eq substr($ent,0,2*$dlen) && "NONE" eq $self->Handle ) {
+ if( 0 <= ( $off= index( $ent, $delim x 2, 2*$dlen ) ) ) {
+ return( substr( $ent, 0, $off ), substr( $ent, 2*$dlen+$off ) );
+ } elsif( $delim eq substr($ent,-$dlen) ) {
+ return( substr($ent,0,-$dlen) );
+ } elsif( 2*$dlen <= ( $off= rindex( $ent, $delim ) ) ) {
+ return( substr( $ent, 0, $off ),
+ undef, substr( $ent, $dlen+$off ) );
+ } elsif( $parent ) {
+ return();
+ } else {
+ return( $ent );
+ }
+ } elsif( $delim eq substr($ent,0,$dlen) && "NONE" ne $self->Handle ) {
+ return( undef, substr($ent,$dlen) );
+ } elsif( $self->{MEMBERS} && $self->_MembersHash->{$ent} ) {
+ return( substr($ent,0,-$dlen) );
+ } elsif( 0 <= ( $off= index( $ent, $delim x 2 ) ) ) {
+ return( substr( $ent, 0, $off ), substr( $ent, 2*$dlen+$off ) );
+ } elsif( $delim eq substr($ent,-$dlen) ) {
+ if( $parent
+ && 0 <= ( $off= rindex( $ent, $delim, length($ent)-2*$dlen ) ) ) {
+ return( substr($ent,0,$off),
+ undef, undef, substr($ent,$dlen+$off,-$dlen) );
+ } else {
+ return( substr($ent,0,-$dlen) );
+ }
+ } elsif( 0 <= ( $off= rindex( $ent, $delim ) ) ) {
+ return(
+ substr( $ent, 0, $off ), undef, substr( $ent, $dlen+$off ) );
+ } else {
+ return( undef, undef, $ent );
+ }
+}
+
+
+sub _FetchValue
+{
+ my $self= shift( @_ );
+ my( $val, $createKey )= @_;
+ my( $data, $type );
+ if( ( $data, $type )= $self->GetValue( $val ) ) {
+ return $self->ArrayValues ? [ $data, $type ]
+ : wantarray ? ( $data, $type )
+ : $data;
+ } elsif( $createKey and $data= $self->new($val) ) {
+ return $data->TiedRef;
+ } else {
+ return ();
+ }
+}
+
+
+sub FETCH
+{
+ my $self= shift(@_);
+ my $ent= shift(@_);
+ my $delim= $self->Delimiter;
+ my( $key, $val, $ambig )= $self->_parseTiedEnt( $ent, $delim, 0 );
+ my $sub;
+ if( defined($key) ) {
+ if( defined($self->{MEMBHASH})
+ && $self->{MEMBHASH}->{$key.$delim}
+ && 0 <= index($key,$delim) ) {
+ return ()
+ unless $sub= $self->new( $key,
+ {"Delimiter"=>$self->OS_Delimiter} );
+ $sub->Delimiter($delim);
+ } else {
+ return ()
+ unless $sub= $self->new( $key );
+ }
+ } else {
+ $sub= $self;
+ }
+ if( defined($val) ) {
+ return $sub->_FetchValue( $val );
+ } elsif( ! defined($ambig) ) {
+ return $sub->TiedRef;
+ } elsif( defined($key) ) {
+ return $sub->FETCH( $ambig );
+ } else {
+ return $sub->_FetchValue( $ambig, "" ne $ambig );
+ }
+}
+
+
+sub _FetchOld
+{
+ my( $self, $key )= @_;
+ my $old= $self->FETCH($key);
+ if( $old ) {
+ my $copy= {};
+ %$copy= %$old;
+ return $copy;
+ }
+ # return $^E;
+ return _Err;
+}
+
+
+sub DELETE
+{
+ my $self= shift(@_);
+ my $ent= shift(@_);
+ my $delim= $self->Delimiter;
+ my( $key, $val, $ambig, $subkey )= $self->_parseTiedEnt( $ent, $delim, 1 );
+ my $sub;
+ my $fast= defined(wantarray) ? $self->FastDelete : 2;
+ my $old= 1; # Value returned if FastDelete is set.
+ if( defined($key)
+ && ( defined($val) || defined($ambig) || defined($subkey) ) ) {
+ return ()
+ unless $sub= $self->new( $key );
+ } else {
+ $sub= $self;
+ }
+ if( defined($val) ) {
+ $old= $sub->GetValue($val) || _Err unless 2 <= $fast;
+ $sub->RegDeleteValue( $val );
+ } elsif( defined($subkey) ) {
+ $old= $sub->_FetchOld( $subkey.$delim ) unless $fast;
+ $sub->RegDeleteKey( $subkey );
+ } elsif( defined($ambig) ) {
+ if( defined($key) ) {
+ $old= $sub->DELETE($ambig);
+ } else {
+ $old= $sub->GetValue($ambig) || _Err unless 2 <= $fast;
+ if( defined( $old ) ) {
+ $sub->RegDeleteValue( $ambig );
+ } else {
+ $old= $sub->_FetchOld( $ambig.$delim ) unless $fast;
+ $sub->RegDeleteKey( $ambig );
+ }
+ }
+ } elsif( defined($key) ) {
+ $old= $sub->_FetchOld( $key.$delim ) unless $fast;
+ $sub->RegDeleteKey( $key );
+ } else {
+ croak "${PACK}->DELETE: Key ($ent) can never be deleted";
+ }
+ return $old;
+}
+
+
+sub SetValue
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ my $name= shift(@_);
+ my $data= shift(@_);
+ my( $type )= @_;
+ my $size;
+ if( ! defined($type) ) {
+ if( "ARRAY" eq ref($data) ) {
+ croak "${PACK}->SetValue: Value is array reference but ",
+ "no data type given"
+ unless 2 == @$data;
+ ( $data, $type )= @$data;
+ } else {
+ $type= REG_SZ;
+ }
+ }
+ $type= _constant($type,"registry value data type") if $type =~ /^REG_/;
+ if( REG_MULTI_SZ == $type && "ARRAY" eq ref($data) ) {
+ $data= join( "\0", @$data ) . "\0\0";
+ ## $data= pack( "a*" x (1+@$data), map( $_."\0", @$data, "" ) );
+ } elsif( ( REG_SZ == $type || REG_EXPAND_SZ == $type )
+ && $self->FixSzNulls ) {
+ $data .= "\0" unless "\0" eq substr($data,0,-1);
+ } elsif( REG_DWORD == $type && $data =~ /^0x[0-9a-fA-F]{3,}$/ ) {
+ $data= pack( "L", hex($data) );
+ # We could to $data=pack("L",$data) for REG_DWORD but I see
+ # no nice way to always distinguish when to do this or not.
+ }
+ return $self->RegSetValueEx( $name, 0, $type, $data, length($data) );
+}
+
+
+sub StoreKey
+{
+ my $this= shift(@_);
+ $this= tied(%$this) if ref($this) && tied(%$this);
+ my $subKey= shift(@_);
+ my $data= shift(@_);
+ my $ent;
+ my $self;
+ if( ! ref($data) || "$data" !~ /(^|=)HASH/ ) {
+ croak "${PACK}->StoreKey: For ", $this->Path.$subKey, ",\n",
+ " subkey data must be a HASH reference";
+ }
+ if( defined( $$data{""} ) && "HASH" eq ref($$data{""}) ) {
+ $self= $this->CreateKey( $subKey, delete $$data{""} );
+ } else {
+ $self= $this->CreateKey( $subKey );
+ }
+ return () if ! defined($self);
+ foreach $ent ( keys(%$data) ) {
+ return ()
+ unless $self->STORE( $ent, $$data{$ent} );
+ }
+ return $self;
+}
+
+
+# = { "" => {OPT=>VAL}, "val"=>[], "key"=>{} } creates a new key
+# = "string" creates a new REG_SZ value
+# = [ data, type ] creates a new value
+sub STORE
+{
+ my $self= shift(@_);
+ my $ent= shift(@_);
+ my $data= shift(@_);
+ my $delim= $self->Delimiter;
+ my( $key, $val, $ambig, $subkey )= $self->_parseTiedEnt( $ent, $delim, 1 );
+ my $sub;
+ if( defined($key)
+ && ( defined($val) || defined($ambig) || defined($subkey) ) ) {
+ return ()
+ unless $sub= $self->new( $key );
+ } else {
+ $sub= $self;
+ }
+ if( defined($val) ) {
+ croak "${PACK}->STORE: For ", $sub->Path.$delim.$val, ",\n",
+ " value data cannot be a HASH reference"
+ if ref($data) && "$data" =~ /(^|=)HASH/;
+ $sub->SetValue( $val, $data );
+ } elsif( defined($subkey) ) {
+ croak "${PACK}->STORE: For ", $sub->Path.$subkey.$delim, ",\n",
+ " subkey data must be a HASH reference"
+ unless ref($data) && "$data" =~ /(^|=)HASH/;
+ $sub->StoreKey( $subkey, $data );
+ } elsif( defined($ambig) ) {
+ if( ref($data) && "$data" =~ /(^|=)HASH/ ) {
+ $sub->StoreKey( $ambig, $data );
+ } else {
+ $sub->SetValue( $ambig, $data );
+ }
+ } elsif( defined($key) ) {
+ croak "${PACK}->STORE: For ", $sub->Path.$key.$delim, ",\n",
+ " subkey data must be a HASH reference"
+ unless ref($data) && "$data" =~ /(^|=)HASH/;
+ $sub->StoreKey( $key, $data );
+ } else {
+ croak "${PACK}->STORE: Key ($ent) can never be created nor set";
+ }
+}
+
+
+sub EXISTS
+{
+ my $self= shift(@_);
+ my $ent= shift(@_);
+ return defined( $self->FETCH($ent) );
+}
+
+
+sub FIRSTKEY
+{
+ my $self= shift(@_);
+ my $members= $self->_MemberNames;
+ $self->{PREVIDX}= 0;
+ return @{$members} ? $members->[0] : undef;
+}
+
+
+sub NEXTKEY
+{
+ my $self= shift(@_);
+ my $prev= shift(@_);
+ my $idx= $self->{PREVIDX};
+ my $members= $self->_MemberNames;
+ if( ! defined($idx) || $prev ne $members->[$idx] ) {
+ $idx= 0;
+ while( $idx < @$members && $prev ne $members->[$idx] ) {
+ $idx++;
+ }
+ }
+ $self->{PREVIDX}= ++$idx;
+ return $members->[$idx];
+}
+
+
+sub DESTROY
+{
+ my $self= shift(@_);
+ return if tied(%$self);
+ my $unload;
+ eval { $unload= $self->{UNLOADME}; 1 }
+ or return;
+ my $debug= $ENV{DEBUG_TIE_REGISTRY};
+ if( defined($debug) ) {
+ if( 1 < $debug ) {
+ my $hand= $self->Handle;
+ my $dep= $self->{DEPENDON};
+ carp "${PACK} destroying ", $self->Path, " (",
+ "NONE" eq $hand ? $hand : sprintf("0x%lX",$hand), ")",
+ defined($dep) ? (" [depends on ",$dep->Path,"]") : ();
+ } else {
+ warn "${PACK} destroying ", $self->Path, ".\n";
+ }
+ }
+ $self->RegCloseKey
+ unless "NONE" eq $self->Handle;
+ if( defined($unload) ) {
+ if( defined($debug) && 1 < $debug ) {
+ my( $obj, $subKey, $file )= @$unload;
+ warn "Unloading ", $self->Path,
+ " (from ", $obj->Path, ", $subKey)...\n";
+ }
+ $self->UnLoad
+ || warn "Couldn't unload ", $self->Path, ": ", _ErrMsg, "\n";
+ ## carp "Never unloaded ${PACK}::Load($$unload[2])";
+ }
+ #delete $self->{DEPENDON};
+}
+
+
+use vars qw( @CreateKey_Opts %CreateKey_Opts %_KeyDispNames );
+@CreateKey_Opts= qw( Access Class Options Delimiter
+ Disposition Security Volatile Backup );
+@CreateKey_Opts{@CreateKey_Opts}= (1) x @CreateKey_Opts;
+%_KeyDispNames= ( REG_CREATED_NEW_KEY() => "REG_CREATED_NEW_KEY",
+ REG_OPENED_EXISTING_KEY() => "REG_OPENED_EXISTING_KEY" );
+
+sub CreateKey
+{
+ my $self= shift(@_);
+ my $tied= tied(%$self);
+ $self= tied(%$self) if $tied;
+ my( $subKey, $opts )= @_;
+ my( $sam )= $self->Access;
+ my( $delim )= $self->Delimiter;
+ my( $class )= "";
+ my( $flags )= 0;
+ my( $secure )= [];
+ my( $garb )= [];
+ my( $result )= \$garb;
+ my( $handle )= 0;
+ if( @_ < 1 || 2 < @_
+ || 2 == @_ && "HASH" ne ref($opts) ) {
+ croak "Usage: \$new= \$old->CreateKey( \$subKey, {OPT=>VAL,...} );\n",
+ " options: @CreateKey_Opts\nCalled";
+ }
+ if( defined($opts) ) {
+ $sam= $opts->{"Access"} if defined($opts->{"Access"});
+ $class= $opts->{Class} if defined($opts->{Class});
+ $flags= $opts->{Options} if defined($opts->{Options});
+ $delim= $opts->{"Delimiter"} if defined($opts->{"Delimiter"});
+ $secure= $opts->{Security} if defined($opts->{Security});
+ if( defined($opts->{Disposition}) ) {
+ "SCALAR" eq ref($opts->{Disposition})
+ or croak "${PACK}->CreateKey option `Disposition'",
+ " must provide a scalar reference";
+ $result= $opts->{Disposition};
+ }
+ if( 0 == $flags ) {
+ $flags |= REG_OPTION_VOLATILE
+ if defined($opts->{Volatile}) && $opts->{Volatile};
+ $flags |= REG_OPTION_BACKUP_RESTORE
+ if defined($opts->{Backup}) && $opts->{Backup};
+ }
+ }
+ my $subPath= ref($subKey) ? $subKey : $self->_split($subKey,$delim);
+ $subKey= join( $self->OS_Delimiter, @$subPath );
+ $self->RegCreateKeyEx( $subKey, 0, $class, $flags, $sam,
+ $secure, $handle, $$result )
+ or return ();
+ if( ! ref($$result) && $self->DualTypes ) {
+ $$result= _DualVal( \%_KeyDispNames, $$result );
+ }
+ my $new= $self->_new( $handle, [ @{$self->_Path}, @{$subPath} ] );
+ $new->{ACCESS}= $sam;
+ $new->{DELIM}= $delim;
+ $new= $new->TiedRef if $tied;
+ return $new;
+}
+
+
+use vars qw( $Load_Cnt @Load_Opts %Load_Opts );
+$Load_Cnt= 0;
+@Load_Opts= qw(NewSubKey);
+@Load_Opts{@Load_Opts}= (1) x @Load_Opts;
+
+sub Load
+{
+ my $this= shift(@_);
+ my $tied= ref($this) && tied(%$this);
+ $this= tied(%$this) if $tied;
+ my( $file, $subKey, $opts )= @_;
+ if( 2 == @_ && "HASH" eq ref($subKey) ) {
+ $opts= $subKey;
+ undef $subKey;
+ }
+ @_ < 1 || 3 < @_ || defined($opts) && "HASH" ne ref($opts)
+ and croak "Usage: \$key= ",
+ "${PACK}->Load( \$fileName, [\$newSubKey,] {OPT=>VAL...} );\n",
+ " options: @Load_Opts @new_Opts\nCalled";
+ if( defined($opts) && exists($opts->{NewSubKey}) ) {
+ $subKey= delete $opts->{NewSubKey};
+ }
+ if( ! defined( $subKey ) ) {
+ if( "" ne $this->Machine ) {
+ ( $this )= $this->_connect( [$this->Machine,"LMachine"] );
+ } else {
+ ( $this )= $this->_rootKey( "LMachine" ); # Could also be "Users"
+ }
+ $subKey= "PerlTie:$$." . ++$Load_Cnt;
+ }
+ $this->RegLoadKey( $subKey, $file )
+ or return ();
+ my $self= $this->new( $subKey, defined($opts) ? $opts : () );
+ if( ! defined( $self ) ) {
+ { my $err= Win32::GetLastError();
+ #{ local( $^E ); #}
+ $this->RegUnLoadKey( $subKey ) or carp
+ "Can't unload $subKey from ", $this->Path, ": ", _ErrMsg, "\n";
+ Win32::SetLastError($err);
+ }
+ return ();
+ }
+ $self->{UNLOADME}= [ $this, $subKey, $file ];
+ $self= $self->TiedRef if $tied;
+ return $self;
+}
+
+
+sub UnLoad
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ @_ and croak "Usage: \$key->UnLoad;";
+ my $unload= $self->{UNLOADME};
+ "ARRAY" eq ref($unload)
+ or croak "${PACK}->UnLoad called on a key which was not Load()ed";
+ my( $obj, $subKey, $file )= @$unload;
+ $self->RegCloseKey;
+ return Win32API::Registry::RegUnLoadKey( $obj->Handle, $subKey );
+}
+
+
+sub AllowSave
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ return $self->AllowPriv( "SeBackupPrivilege", @_ );
+}
+
+
+sub AllowLoad
+{
+ my $self= shift(@_);
+ $self= tied(%$self) if tied(%$self);
+ return $self->AllowPriv( "SeRestorePrivilege", @_ );
+}
+
+
+# RegNotifyChangeKeyValue( hKey, bWatchSubtree, iNotifyFilter, hEvent, bAsync )
+
+
+sub RegCloseKey { my $self= shift(@_);
+ Win32API::Registry::RegCloseKey $self->Handle, @_; }
+sub RegConnectRegistry { my $self= shift(@_);
+ Win32API::Registry::RegConnectRegistry @_; }
+sub RegCreateKey { my $self= shift(@_);
+ Win32API::Registry::RegCreateKey $self->Handle, @_; }
+sub RegCreateKeyEx { my $self= shift(@_);
+ Win32API::Registry::RegCreateKeyEx $self->Handle, @_; }
+sub RegDeleteKey { my $self= shift(@_);
+ Win32API::Registry::RegDeleteKey $self->Handle, @_; }
+sub RegDeleteValue { my $self= shift(@_);
+ Win32API::Registry::RegDeleteValue $self->Handle, @_; }
+sub RegEnumKey { my $self= shift(@_);
+ Win32API::Registry::RegEnumKey $self->Handle, @_; }
+sub RegEnumKeyEx { my $self= shift(@_);
+ Win32API::Registry::RegEnumKeyEx $self->Handle, @_; }
+sub RegEnumValue { my $self= shift(@_);
+ Win32API::Registry::RegEnumValue $self->Handle, @_; }
+sub RegFlushKey { my $self= shift(@_);
+ Win32API::Registry::RegFlushKey $self->Handle, @_; }
+sub RegGetKeySecurity { my $self= shift(@_);
+ Win32API::Registry::RegGetKeySecurity $self->Handle, @_; }
+sub RegLoadKey { my $self= shift(@_);
+ Win32API::Registry::RegLoadKey $self->Handle, @_; }
+sub RegNotifyChangeKeyValue { my $self= shift(@_);
+ Win32API::Registry::RegNotifyChangeKeyValue $self->Handle, @_; }
+sub RegOpenKey { my $self= shift(@_);
+ Win32API::Registry::RegOpenKey $self->Handle, @_; }
+sub RegOpenKeyEx { my $self= shift(@_);
+ Win32API::Registry::RegOpenKeyEx $self->Handle, @_; }
+sub RegQueryInfoKey { my $self= shift(@_);
+ Win32API::Registry::RegQueryInfoKey $self->Handle, @_; }
+sub RegQueryMultipleValues { my $self= shift(@_);
+ Win32API::Registry::RegQueryMultipleValues $self->Handle, @_; }
+sub RegQueryValue { my $self= shift(@_);
+ Win32API::Registry::RegQueryValue $self->Handle, @_; }
+sub RegQueryValueEx { my $self= shift(@_);
+ Win32API::Registry::RegQueryValueEx $self->Handle, @_; }
+sub RegReplaceKey { my $self= shift(@_);
+ Win32API::Registry::RegReplaceKey $self->Handle, @_; }
+sub RegRestoreKey { my $self= shift(@_);
+ Win32API::Registry::RegRestoreKey $self->Handle, @_; }
+sub RegSaveKey { my $self= shift(@_);
+ Win32API::Registry::RegSaveKey $self->Handle, @_; }
+sub RegSetKeySecurity { my $self= shift(@_);
+ Win32API::Registry::RegSetKeySecurity $self->Handle, @_; }
+sub RegSetValue { my $self= shift(@_);
+ Win32API::Registry::RegSetValue $self->Handle, @_; }
+sub RegSetValueEx { my $self= shift(@_);
+ Win32API::Registry::RegSetValueEx $self->Handle, @_; }
+sub RegUnLoadKey { my $self= shift(@_);
+ Win32API::Registry::RegUnLoadKey $self->Handle, @_; }
+sub AllowPriv { my $self= shift(@_);
+ Win32API::Registry::AllowPriv @_; }
+
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+
+__END__
+
+=pod
+
+=head1 NAME
+
+Win32::TieRegistry - Manipulate the Win32 Registry
+
+=head1 SYNOPSIS
+
+ use Win32::TieRegistry 0.20 ( UseOptionName=>UseOptionValue[,...] );
+
+ $Registry->SomeMethodCall(arg1,...);
+
+ $subKey= $Registry->{"Key\\SubKey\\"};
+ $valueData= $Registry->{"Key\\SubKey\\\\ValueName"};
+ $Registry->{"Key\\SubKey\\"}= { "NewSubKey" => {...} };
+ $Registry->{"Key\\SubKey\\\\ValueName"}= "NewValueData";
+ $Registry->{"\\ValueName"}= [ pack("fmt",$data), REG_DATATYPE ];
+
+=head1 EXAMPLES
+
+ use Win32::TieRegistry( Delimiter=>"#", ArrayValues=>0 );
+ $pound= $Registry->Delimiter("/");
+ $diskKey= $Registry->{"LMachine/System/Disk/"}
+ or die "Can't read LMachine/System/Disk key: $^E\n";
+ $data= $diskKey->{"/Information"}
+ or die "Can't read LMachine/System/Disk//Information value: $^E\n";
+ $remoteKey= $Registry->{"//ServerA/LMachine/System/"}
+ or die "Can't read //ServerA/LMachine/System/ key: $^E\n";
+ $remoteData= $remoteKey->{"Disk//Information"}
+ or die "Can't read ServerA's System/Disk//Information value: $^E\n";
+ foreach $entry ( keys(%$diskKey) ) {
+ ...
+ }
+ foreach $subKey ( $diskKey->SubKeyNames ) {
+ ...
+ }
+ $diskKey->AllowSave( 1 );
+ $diskKey->RegSaveKey( "C:/TEMP/DiskReg", [] );
+
+=head1 DESCRIPTION
+
+The I<Win32::TieRegistry> module lets you manipulate the Registry
+via objects [as in "object oriented"] or via tied hashes. But
+you will probably mostly use a combination reference, that is, a
+reference to a tied hash that has also been made an object so that
+you can mix both access methods [as shown above].
+
+If you did not get this module as part of L<libwin32>, you might
+want to get a recent version of L<libwin32> from CPAN which should
+include this module and the I<Win32API::Registry> module that it
+uses.
+
+Skip to the L<SUMMARY> section if you just want to dive in and start
+using the Registry from Perl.
+
+Accessing and manipulating the registry is extremely simple using
+I<Win32::TieRegistry>. A single, simple expression can return
+you almost any bit of information stored in the Registry.
+I<Win32::TieRegistry> also gives you full access to the "raw"
+underlying API calls so that you can do anything with the Registry
+in Perl that you could do in C. But the "simple" interface has
+been carefully designed to handle almost all operations itself
+without imposing arbitrary limits while providing sensible
+defaults so you can list only the parameters you care about.
+
+But first, an overview of the Registry itself.
+
+=head2 The Registry
+
+The Registry is a forest: a collection of several tree structures.
+The root of each tree is a key. These root keys are identified by
+predefined constants whose names start with "HKEY_". Although all
+keys have a few attributes associated with each [a class, a time
+stamp, and security information], the most important aspect of keys
+is that each can contain subkeys and can contain values.
+
+Each subkey has a name: a string which cannot be blank and cannot
+contain the delimiter character [backslash: C<'\\'>] nor nul
+[C<'\0'>]. Each subkey is also a key and so can contain subkeys
+and values [and has a class, time stamp, and security information].
+
+Each value has a name: a string which B<can> be blank and B<can>
+contain the delimiter character [backslash: C<'\\'>] and any
+character except for null, C<'\0'>. Each value also has data
+associated with it. Each value's data is a contiguous chunk of
+bytes, which is exactly what a Perl string value is so Perl
+strings will usually be used to represent value data.
+
+Each value also has a data type which says how to interpret the
+value data. The primary data types are:
+
+=over
+
+=item REG_SZ
+
+A null-terminated string.
+
+=item REG_EXPAND_SZ
+
+A null-terminated string which contains substrings consisting of a
+percent sign [C<'%'>], an environment variable name, then a percent
+sign, that should be replaced with the value associate with that
+environment variable. The system does I<not> automatically do this
+substitution.
+
+=item REG_BINARY
+
+Some arbitrary binary value. You can think of these as being
+"packed" into a string.
+
+If your system has the L<SetDualVar> module installed,
+the C<DualBinVals()> option wasn't turned off, and you
+fetch a C<REG_BINARY> value of 4 bytes or fewer, then
+you can use the returned value in a numeric context to
+get at the "unpacked" numeric value. See C<GetValue()>
+for more information.
+
+=item REG_MULTI_SZ
+
+Several null-terminated strings concatenated together with an
+extra trailing C<'\0'> at the end of the list. Note that the list
+can include empty strings so use the value's length to determine
+the end of the list, not the first occurrence of C<'\0\0'>.
+It is best to set the C<SplitMultis()> option so I<Win32::TieRegistry>
+will split these values into an array of strings for you.
+
+=item REG_DWORD
+
+A long [4-byte] integer value. These values are expected either
+packed into a 4-character string or as a hex string of B<more than>
+4 characters [but I<not> as a numeric value, unfortunately, as there is
+no sure way to tell a numeric value from a packed 4-byte string that
+just happens to be a string containing a valid numeric value].
+
+How such values are returned depends on the C<DualBinVals()> and
+C<DWordsToHex()> options. See C<GetValue()> for details.
+
+=back
+
+In the underlying Registry calls, most places which take a
+subkey name also allow you to pass in a subkey "path" -- a
+string of several subkey names separated by the delimiter
+character, backslash [C<'\\'>]. For example, doing
+C<RegOpenKeyEx(HKEY_LOCAL_MACHINE,"SYSTEM\\DISK",...)> is much
+like opening the C<"SYSTEM"> subkey of C<HKEY_LOCAL_MACHINE>,
+then opening its C<"DISK"> subkey, then closing the C<"SYSTEM">
+subkey.
+
+All of the I<Win32::TieRegistry> features allow you to use your
+own delimiter in place of the system's delimiter, [C<'\\'>]. In
+most of our examples we will use a forward slash [C<'/'>] as our
+delimiter as it is easier to read and less error prone to use when
+writing Perl code since you have to type two backslashes for each
+backslash you want in a string. Note that this is true even when
+using single quotes -- C<'\\HostName\LMachine\'> is an invalid
+string and must be written as C<'\\\\HostName\\LMachine\\'>.
+
+You can also connect to the registry of other computers on your
+network. This will be discussed more later.
+
+Although the Registry does not have a single root key, the
+I<Win32::TieRegistry> module creates a virtual root key for you
+which has all of the I<HKEY_*> keys as subkeys.
+
+=head2 Tied Hashes Documentation
+
+Before you can use a tied hash, you must create one. One way to
+do that is via:
+
+ use Win32::TieRegistry ( TiedHash => '%RegHash' );
+
+which exports a C<%RegHash> variable into your package and ties it
+to the virtual root key of the Registry. An alternate method is:
+
+ my %RegHash;
+ use Win32::TieRegistry ( TiedHash => \%RegHash );
+
+There are also several ways you can tie a hash variable to any
+other key of the Registry, which are discussed later.
+
+Note that you will most likely use C<$Registry> instead of using
+a tied hash. C<$Registry> is a reference to a hash that has
+been tied to the virtual root of your computer's Registry [as if,
+C<$Registry= \%RegHash>]. So you would use C<$Registry-E<gt>{Key}>
+rather than C<$RegHash{Key}> and use C<keys %{$Registry}> rather
+than C<keys %RegHash>, for example.
+
+For each hash which has been tied to a Registry key, the Perl
+C<keys> function will return a list containing the name of each
+of the key's subkeys with a delimiter character appended to it and
+containing the name of each of the key's values with a delimiter
+prepended to it. For example:
+
+ keys( %{ $Registry->{"HKEY_CLASSES_ROOT\\batfile\\"} } )
+
+might yield the following list value:
+
+ ( "DefaultIcon\\", # The subkey named "DefaultIcon"
+ "shell\\", # The subkey named "shell"
+ "shellex\\", # The subkey named "shellex"
+ "\\", # The default value [named ""]
+ "\\EditFlags" ) # The value named "EditFlags"
+
+For the virtual root key, short-hand subkey names are used as
+shown below. You can use the short-hand name, the regular
+I<HKEY_*> name, or any numeric value to access these keys, but
+the short-hand names are all that will be returned by the C<keys>
+function.
+
+=over
+
+=item "Classes" for HKEY_CLASSES_ROOT
+
+Contains mappings between file name extensions and the uses
+for such files along with configuration information for COM
+[MicroSoft's Common Object Model] objects. Usually a link to
+the C<"SOFTWARE\\Classes"> subkey of the C<HKEY_LOCAL_MACHINE>
+key.
+
+=item "CUser" for HKEY_CURRENT_USER
+
+Contains information specific to the currently logged-in user.
+Mostly software configuration information. Usually a link to
+a subkey of the C<HKEY_USERS> key.
+
+=item "LMachine" for HKEY_LOCAL_MACHINE
+
+Contains all manner of information about the computer.
+
+=item "Users" for HKEY_USERS
+
+Contains one subkey, C<".DEFAULT">, which gets copied to a new
+subkey whenever a new user is added. Also contains a subkey for
+each user of the system, though only those for active users
+[usually only one] are loaded at any given time.
+
+=item "PerfData" for HKEY_PERFORMANCE_DATA
+
+Used to access data about system performance. Access via this key
+is "special" and all but the most carefully constructed calls will
+fail, usually with C<ERROR_INSUFFICIENT_BUFFER>. For example, you
+can't enumerate key names without also enumerating values which
+require huge buffers but the exact buffer size required cannot be
+determined beforehand because C<RegQueryInfoKey()> B<always> fails
+with C<ERROR_INSUFFICIENT_BUFFER> for C<HKEY_PERFORMANCE_DATA> no
+matter how it is called. So it is currently not very useful to
+tie a hash to this key. You can use it to create an object to use
+for making carefully constructed calls to the underlying Reg*()
+routines.
+
+=item "CConfig" for HKEY_CURRENT_CONFIG
+
+Contains minimal information about the computer's current
+configuration that is required very early in the boot process.
+For example, setting for the display adapter such as screen
+resolution and refresh rate are found in here.
+
+=item "DynData" for HKEY_DYN_DATA
+
+Dynamic data. We have found no documentation for this key.
+
+=back
+
+A tied hash is much like a regular hash variable in Perl -- you give
+it a key string inside braces, [C<{> and C<}>], and it gives you
+back a value [or lets you set a value]. For I<Win32::TieRegistry>
+hashes, there are two types of values that will be returned.
+
+=over
+
+=item SubKeys
+
+If you give it a string which represents a subkey, then it will
+give you back a reference to a hash which has been tied to that
+subkey. It can't return the hash itself, so it returns a
+reference to it. It also blesses that reference so that it is
+also an object so you can use it to call method functions.
+
+=item Values
+
+If you give it a string which is a value name, then it will give
+you back a string which is the data for that value. Alternately,
+you can request that it give you both the data value string and
+the data value type [we discuss how to request this later]. In
+this case, it would return a reference to an array where the value
+data string is element C<[0]> and the value data type is element
+C<[1]>.
+
+=back
+
+The key string which you use in the tied hash must be interpreted
+to determine whether it is a value name or a key name or a path
+that combines several of these or even other things. There are
+two simple rules that make this interpretation easy and
+unambiguous:
+
+ Put a delimiter after each key name.
+ Put a delimiter in front of each value name.
+
+Exactly how the key string will be interpreted is governed by the
+following cases, in the order listed. These cases are designed
+to "do what you mean". Most of the time you won't have to think
+about them, especially if you follow the two simple rules above.
+After the list of cases we give several examples which should be
+clear enough so feel free to skip to them unless you are worried
+about the details.
+
+=over
+
+=item Remote machines
+
+If the hash is tied to the virtual root of the registry [or the
+virtual root of a remote machine's registry], then we treat hash
+key strings which start with the delimiter character specially.
+
+If the hash key string starts with two delimiters in a row, then
+those should be immediately followed by the name of a remote
+machine whose registry we wish to connect to. That can be
+followed by a delimiter and more subkey names, etc. If the
+machine name is not following by anything, then a virtual root
+for the remote machine's registry is created, a hash is tied to
+it, and a reference to that hash it is returned.
+
+=item Hash key string starts with the delimiter
+
+If the hash is tied to a virtual root key, then the leading
+delimiter is ignored. It should be followed by a valid Registry
+root key name [either a short-hand name like C<"LMachine">, an
+I<HKEY_*> value, or a numeric value]. This alternate notation is
+allowed in order to be more consistent with the C<Open()> method
+function.
+
+For all other Registry keys, the leading delimiter indicates
+that the rest of the string is a value name. The leading
+delimiter is stripped and the rest of the string [which can
+be empty and can contain more delimiters] is used as a value
+name with no further parsing.
+
+=item Exact match with direct subkey name followed by delimiter
+
+If you have already called the Perl C<keys> function on the tied
+hash [or have already called C<MemberNames> on the object] and the
+hash key string exactly matches one of the strings returned, then
+no further parsing is done. In other words, if the key string
+exactly matches the name of a direct subkey with a delimiter
+appended, then a reference to a hash tied to that subkey is
+returned [but only if C<keys> or C<MemberNames> has already
+been called for that tied hash].
+
+This is only important if you have selected a delimiter other than
+the system default delimiter and one of the subkey names contains
+the delimiter you have chosen. This rule allows you to deal with
+subkeys which contain your chosen delimiter in their name as long
+as you only traverse subkeys one level at a time and always
+enumerate the list of members before doing so.
+
+The main advantage of this is that Perl code which recursively
+traverses a hash will work on hashes tied to Registry keys even if
+a non-default delimiter has been selected.
+
+=item Hash key string contains two delimiters in a row
+
+If the hash key string contains two [or more] delimiters in a row,
+then the string is split between the first pair of delimiters.
+The first part is interpreted as a subkey name or a path of subkey
+names separated by delimiters and with a trailing delimiter. The
+second part is interpreted as a value name with one leading
+delimiter [any extra delimiters are considered part of the value
+name].
+
+=item Hash key string ends with a delimiter
+
+If the key string ends with a delimiter, then it is treated
+as a subkey name or path of subkey names separated by delimiters.
+
+=item Hash key string contains a delimiter
+
+If the key string contains a delimiter, then it is split after
+the last delimiter. The first part is treated as a subkey name or
+path of subkey names separated by delimiters. The second part
+is ambiguous and is treated as outlined in the next item.
+
+=item Hash key string contains no delimiters
+
+If the hash key string contains no delimiters, then it is ambiguous.
+
+If you are reading from the hash [fetching], then we first use the
+key string as a value name. If there is a value with a matching
+name in the Registry key which the hash is tied to, then the value
+data string [and possibly the value data type] is returned.
+Otherwise, we retry by using the hash key string as a subkey name.
+If there is a subkey with a matching name, then we return a
+reference to a hash tied to that subkey. Otherwise we return
+C<undef>.
+
+If you are writing to the hash [storing], then we use the key
+string as a subkey name only if the value you are storing is a
+reference to a hash value. Otherwise we use the key string as
+a value name.
+
+=back
+
+=head3 Examples
+
+Here are some examples showing different ways of accessing Registry
+information using references to tied hashes:
+
+=over
+
+=item Canonical value fetch
+
+ $tip18= $Registry->{"HKEY_LOCAL_MACHINE\\Software\\Microsoft\\"
+ . 'Windows\\CurrentVersion\\Explorer\\Tips\\\\18'};
+
+Should return the text of important tip number 18. Note that two
+backslashes, C<"\\">, are required to get a single backslash into
+a Perl double-quoted or single-qouted string. Note that C<"\\">
+is appended to each key name [C<"HKEY_LOCAL_MACHINE"> through
+C<"Tips">] and C<"\\"> is prepended to the value name, C<"18">.
+
+=item Changing your delimiter
+
+ $Registry->Delimiter("/");
+ $tip18= $Registry->{"HKEY_LOCAL_MACHINE/Software/Microsoft/"
+ . 'Windows/CurrentVersion/Explorer/Tips//18'};
+
+This usually makes things easier to read when working in Perl.
+All remaining examples will assume the delimiter has been changed
+as above.
+
+=item Using intermediate keys
+
+ $ms= $Registry->{"LMachine/Software/Microsoft/"};
+ $tips= $ms->{"Windows/CurrentVersion/Explorer/Tips/"};
+ $tip18= $winlogon->{"/18"};
+
+Same as above but opens more keys into the Registry which lets you
+efficiently re-access those intermediate keys. This is slightly
+less efficient if you never reuse those intermediate keys.
+
+=item Chaining in a single statement
+
+ $tip18= $Registry->{"LMachine/Software/Microsoft/"}->
+ {"Windows/CurrentVersion/Explorer/Tips/"}->{"/18"};
+
+Like above, this creates intermediate key objects then uses
+them to access other data. Once this statement finishes, the
+intermediate key objects are destroyed. Several handles into
+the Registry are opened and closed by this statement so it is
+less efficient but there are times when this will be useful.
+
+=item Even less efficient example of chaining
+
+ $tip18= $Registry->{"LMachine/Software/Microsoft"}->
+ {"Windows/CurrentVersion/Explorer/Tips"}->{"/18"};
+
+Because we left off the trailing delimiters, I<Win32::TieRegistry>
+doesn't know whether final names, C<"Microsoft"> and C<"Tips">,
+are subkey names or value names. So this statement ends up
+executing the same code as the next one.
+
+=item What the above really does
+
+ $tip18= $Registry->{"LMachine/Software/"}->{"Microsoft"}->
+ {"Windows/CurrentVersion/Explorer/"}->{"Tips"}->{"/18"};
+
+With more chains to go through, more temporary objects are created
+and later destroyed than in our first chaining example. Also,
+when C<"Microsoft"> is looked up, I<Win32::TieRegistry> first
+tries to open it as a value and fails then tries it as a subkey.
+The same is true for when it looks up C<"Tips">.
+
+=item Getting all of the tips
+
+ $tips= $Registry->{"LMachine/Software/Microsoft/"}->
+ {"Windows/CurrentVersion/Explorer/Tips/"}
+ or die "Can't find the Windows tips: $^E\n";
+ foreach( keys %$tips ) {
+ print "$_: ", $tips->{$_}, "\n";
+ }
+
+First notice that we actually check for failure for the first
+time. We are assuming that the C<"Tips"> key contains no subkeys.
+Otherwise the C<print> statement would show something like
+C<"Win32::TieRegistry=HASH(0xc03ebc)"> for each subkey.
+
+The output from the above code will start something like:
+
+ /0: If you don't know how to do something,[...]
+
+=back
+
+=head3 Deleting items
+
+You can use the Perl C<delete> function to delete a value from a
+Registry key or to delete a subkey as long that subkey contains
+no subkeys of its own. See L<More Examples>, below, for more
+information.
+
+=head3 Storing items
+
+You can use the Perl assignment operator [C<=>] to create new
+keys, create new values, or replace values. The values you store
+should be in the same format as the values you would fetch from a
+tied hash. For example, you can use a single assignment statement
+to copy an entire Registry tree. The following statement:
+
+ $Registry->{"LMachine/Software/Classes/Tie_Registry/"}=
+ $Registry->{"LMachine/Software/Classes/batfile/"};
+
+creates a C<"Tie_Registry"> subkey under the C<"Software\\Classes">
+subkey of the C<HKEY_LOCAL_MACHINE> key. Then it populates it
+with copies of all of the subkeys and values in the C<"batfile">
+subkey and all of its subkeys. Note that you need to have
+called C<$Registry-E<gt>ArrayValues(1)> for the proper value data
+type information to be copied. Note also that this release of
+I<Win32::TieRegistry> does not copy key attributes such as class
+name and security information [this is planned for a future release].
+
+The following statement creates a whole subtree in the Registry:
+
+ $Registry->{"LMachine/Software/FooCorp/"}= {
+ "FooWriter/" => {
+ "/Version" => "4.032",
+ "Startup/" => {
+ "/Title" => "Foo Writer Deluxe ][",
+ "/WindowSize" => [ pack("LL",$wid,$ht), "REG_BINARY" ],
+ "/TaskBarIcon" => [ "0x0001", "REG_DWORD" ],
+ },
+ "Compatibility/" => {
+ "/AutoConvert" => "Always",
+ "/Default Palette" => "Windows Colors",
+ },
+ },
+ "/License", => "0123-9C8EF1-09-FC",
+ };
+
+Note that all but the last Registry key used on the left-hand
+side of the assignment [that is, "LMachine/Software/" but not
+"FooCorp/"] must already exist for this statement to succeed.
+
+By using the leading a trailing delimiters on each subkey name and
+value name, I<Win32::TieRegistry> will tell you if you try to assign
+subkey information to a value or visa-versa.
+
+=head3 More examples
+
+=over
+
+=item Adding a new tip
+
+ $tips= $Registry->{"LMachine/Software/Microsoft/"}->
+ {"Windows/CurrentVersion/Explorer/Tips/"}
+ or die "Can't find the Windows tips: $^E\n";
+ $tips{'/186'}= "Be very careful when making changes to the Registry!";
+
+=item Deleting our new tip
+
+ $tips= $Registry->{"LMachine/Software/Microsoft/"}->
+ {"Windows/CurrentVersion/Explorer/Tips/"}
+ or die "Can't find the Windows tips: $^E\n";
+ $tip186= delete $tips{'/186'};
+
+Note that Perl's C<delete> function returns the value that was deleted.
+
+=item Adding a new tip differently
+
+ $Registry->{"LMachine/Software/Microsoft/" .
+ "Windows/CurrentVersion/Explorer/Tips//186"}=
+ "Be very careful when making changes to the Registry!";
+
+=item Deleting differently
+
+ $tip186= delete $Registry->{"LMachine/Software/Microsoft/Windows/" .
+ "CurrentVersion/Explorer/Tips//186"};
+
+Note that this only deletes the tail of what we looked up, the
+C<"186"> value, not any of the keys listed.
+
+=item Deleting a key
+
+WARNING: The following code will delete all information about the
+current user's tip preferences. Actually executing this command
+would probably cause the user to see the Welcome screen the next
+time they log in and may cause more serious problems. This
+statement is shown as an example only and should not be used when
+experimenting.
+
+ $tips= delete $Registry->{"CUser/Software/Microsoft/Windows/" .
+ "CurrentVersion/Explorer/Tips/"};
+
+This deletes the C<"Tips"> key and the values it contains. The
+C<delete> function will return a reference to a hash [not a tied
+hash] containing the value names and value data that were deleted.
+
+The information to be returned is copied from the Registry into a
+regular Perl hash before the key is deleted. If the key has many
+subkeys, this copying could take a significant amount of memory
+and/or processor time. So you can disable this process by calling
+the C<FastDelete> member function:
+
+ $prevSetting= $regKey->FastDelete(1);
+
+which will cause all subsequent delete operations via C<$regKey>
+to simply return a true value if they succeed. This optimization
+is automatically done if you use C<delete> in a void context.
+
+=item Technical notes on deleting
+
+If you use C<delete> to delete a Registry key or value and use
+the return value, then I<Win32::TieRegistry> usually looks up the
+current contents of that key or value so they can be returned if
+the deletion is successful. If the deletion succeeds but the
+attempt to lookup the old contents failed, then the return value
+of C<delete> will be C<$^E> from the failed part of the operation.
+
+=item Undeleting a key
+
+ $Registry->{"LMachine/Software/Microsoft/Windows/" .
+ "CurrentVersion/Explorer/Tips/"}= $tips;
+
+This adds back what we just deleted. Note that this version of
+I<Win32::TieRegistry> will use defaults for the key attributes
+[such as class name and security] and will not restore the
+previous attributes.
+
+=item Not deleting a key
+
+WARNING: Actually executing the following code could cause
+serious problems. This statement is shown as an example only and
+should not be used when experimenting.
+
+ $res= delete $Registry->{"CUser/Software/Microsoft/Windows/"}
+ defined($res) || die "Can't delete URL key: $^E\n";
+
+Since the "Windows" key should contain subkeys, that C<delete>
+statement should make no changes to the Registry, return C<undef>,
+and set C<$^E> to "Access is denied".
+
+=item Not deleting again
+
+ $tips= $Registry->{"CUser/Software/Microsoft/Windows/" .
+ "CurrentVersion/Explorer/Tips/"};
+ delete $tips;
+
+The Perl C<delete> function requires that its argument be an
+expression that ends in a hash element lookup [or hash slice],
+which is not the case here. The C<delete> function doesn't
+know which hash $tips came from and so can't delete it.
+
+=back
+
+=head2 Objects Documentation
+
+The following member functions are defined for use on
+I<Win32::TieRegistry> objects:
+
+=over
+
+=item new
+
+The C<new> method creates a new I<Win32::TieRegistry> object.
+C<new> is mostly a synonym for C<Open()> so see C<Open()> below for
+information on what arguments to pass in. Examples:
+
+ $machKey= Win32::TieRegistry->new("LMachine")
+ or die "Can't access HKEY_LOCAL_MACHINE key: $^E\n";
+ $userKey= Win32::TieRegistry->new("CUser")
+ or die "Can't access HKEY_CURRENT_USER key: $^E\n";
+
+Note that calling C<new> via a reference to a tied hash returns
+a simple object, not a reference to a tied hash.
+
+=item Open
+
+=item $subKey= $key->Open( $sSubKey, $rhOptions )
+
+The C<Open> method opens a Registry key and returns a new
+I<Win32::TieRegistry> object associated with that Registry key.
+If C<Open> is called via a reference to a tied hash, then C<Open>
+returns another reference to a tied hash. Otherwise C<Open>
+returns a simple object and you should then use C<TiedRef> to get
+a reference to a tied hash.
+
+C<$sSubKey> is a string specifying a subkey to be opened.
+Alternately C<$sSubKey> can be a reference to an array value
+containing the list of increasingly deep subkeys specifying the
+path to the subkey to be opened.
+
+C<$rhOptions> is an optional reference to a hash containing extra
+options. The C<Open> method supports two options, C<"Delimiter">
+and C<"Access">, and C<$rhOptions> should have only have zero or
+more of these strings as keys. See the "Examples" section below
+for more information.
+
+The C<"Delimiter"> option specifies what string [usually a single
+character] will be used as the delimiter to be appended to subkey
+names and prepended to value names. If this option is not specified,
+the new key [C<$subKey>] inherits the delimiter of the old key
+[C<$key>].
+
+The C<"Access"> option specifies what level of access to the
+Registry key you wish to have once it has been opened. If this
+option is not specified, the new key [C<$subKey>] is opened with
+the same access level used when the old key [C<$key>] was opened.
+The virtual root of the Registry pretends it was opened with
+access C<KEY_READ()|KEY_WRITE()> so this is the default access when
+opening keys directory via C<$Registry>. If you don't plan on
+modifying a key, you should open it with C<KEY_READ> access as
+you may not have C<KEY_WRITE> access to it or some of its subkeys.
+
+If the C<"Access"> option value is a string that starts with
+C<"KEY_">, then it should match B<one> of the predefined access
+levels [probably C<"KEY_READ">, C<"KEY_WRITE">, or
+C<"KEY_ALL_ACCESS">] exported by the I<Win32API::Registry> module.
+Otherwise, a numeric value is expected. For maximum flexibility,
+include C<use Win32::TieRegistry qw(:KEY_);>, for example, near
+the top of your script so you can specify more complicated access
+levels such as C<KEY_READ()|KEY_WRITE()>.
+
+If C<$sSubKey> does not begin with the delimiter [or C<$sSubKey>
+is an array reference], then the path to the subkey to be opened
+will be relative to the path of the original key [C<$key>]. If
+C<$sSubKey> begins with a single delimiter, then the path to the
+subkey to be opened will be relative to the virtual root of the
+Registry on whichever machine the original key resides. If
+C<$sSubKey> begins with two consecutive delimiters, then those
+must be followed by a machine name which causes the C<Connect()>
+method function to be called.
+
+Examples:
+
+ $machKey= $Registry->Open( "LMachine", {Access=>KEY_READ(),Delimiter=>"/"} )
+ or die "Can't open HKEY_LOCAL_MACHINE key: $^E\n";
+ $swKey= $machKey->Open( "Software" );
+ $logonKey= $swKey->Open( "Microsoft/Windows NT/CurrentVersion/Winlogon/" );
+ $NTversKey= $swKey->Open( ["Microsoft","Windows NT","CurrentVersion"] );
+ $versKey= $swKey->Open( qw(Microsoft Windows CurrentVersion) );
+
+ $remoteKey= $Registry->Open( "//HostA/LMachine/System/", {Delimiter=>"/"} )
+ or die "Can't connect to HostA or can't open subkey: $^E\n";
+
+=item Clone
+
+=item $copy= $key->Clone
+
+Creates a new object that is associated with the same Registry key
+as the invoking object.
+
+=item Connect
+
+=item $remoteKey= $Registry->Connect( $sMachineName, $sKeyPath, $rhOptions )
+
+The C<Connect> method connects to the Registry of a remote machine,
+and opens a key within it, then returns a new I<Win32::TieRegistry>
+object associated with that remote Registry key. If C<Connect>
+was called using a reference to a tied hash, then the return value
+will also be a reference to a tied hash [or C<undef>]. Otherwise,
+if you wish to use the returned object as a tied hash [not just as
+an object], then use the C<TiedRef> method function after C<Connect>.
+
+C<$sMachineName> is the name of the remote machine. You don't have
+to precede the machine name with two delimiter characters.
+
+C<$sKeyPath> is a string specifying the remote key to be opened.
+Alternately C<$sKeyPath> can be a reference to an array value
+containing the list of increasingly deep keys specifying the path
+to the key to be opened.
+
+C<$rhOptions> is an optional reference to a hash containing extra
+options. The C<Connect> method supports two options, C<"Delimiter">
+and C<"Access">. See the C<Open> method documentation for more
+information on these options.
+
+C<$sKeyPath> is already relative to the virtual root of the Registry
+of the remote machine. A single leading delimiter on C<sKeyPath>
+will be ignored and is not required.
+
+C<$sKeyPath> can be empty in which case C<Connect> will return an
+object representing the virtual root key of the remote Registry.
+Each subsequent use of C<Open> on this virtual root key will call
+the system C<RegConnectRegistry> function.
+
+The C<Connect> method can be called via any I<Win32::TieRegistry>
+object, not just C<$Registry>. Attributes such as the desired
+level of access and the delimiter will be inherited from the
+object used but the C<$sKeyPath> will always be relative to the
+virtual root of the remote machine's registry.
+
+Examples:
+
+ $remMachKey= $Registry->Connect( "HostA", "LMachine", {Delimiter->"/"} )
+ or die "Can't connect to HostA's HKEY_LOCAL_MACHINE key: $^E\n";
+
+ $remVersKey= $remMachKey->Connect( "www.microsoft.com",
+ "LMachine/Software/Microsoft/Inetsrv/CurrentVersion/",
+ { Access=>KEY_READ, Delimiter=>"/" } )
+ or die "Can't check what version of IIS Microsoft is running: $^E\n";
+
+ $remVersKey= $remMachKey->Connect( "www",
+ qw(LMachine Software Microsoft Inetsrv CurrentVersion) )
+ or die "Can't check what version of IIS we are running: $^E\n";
+
+=item ObjectRef
+
+=item $object_ref= $obj_or_hash_ref->ObjectRef
+
+For a simple object, just returns itself [C<<$obj == $obj->ObjectRef>>].
+
+For a reference to a tied hash [if it is also an object], C<ObjectRef>
+returns the simple object that the hash is tied to.
+
+This is primarily useful when debugging since typing C<x $Registry>
+will try to display your I<entire> registry contents to your screen.
+But the debugger command C<<x $Registry->ObjectRef>> will just dump
+the implementation details of the underlying object to your screen.
+
+=item Flush( $bFlush )
+
+Flushes all cached information about the Registry key so that future
+uses will get fresh data from the Registry.
+
+If the optional C<$bFlush> is specified and a true value, then
+C<RegFlushKey()> will be called, which is almost never necessary.
+
+=item GetValue
+
+=item $ValueData= $key->GetValue( $sValueName )
+
+=item ($ValueData,$ValueType)= $key->GetValue( $sValueName )
+
+Gets a Registry value's data and data type.
+
+C<$ValueData> is usually just a Perl string that contains the
+value data [packed into it]. For certain types of data, however,
+C<$ValueData> may be processed as described below.
+
+C<$ValueType> is the C<REG_*> constant describing the type of value
+data stored in C<$ValueData>. If the C<DualTypes()> option is on,
+then C<$ValueType> will be a dual value. That is, when used in a
+numeric context, C<$ValueType> will give the numeric value of a
+C<REG_*> constant. However, when used in a non-numeric context,
+C<$ValueType> will return the name of the C<REG_*> constant, for
+example C<"REG_SZ"> [note the quotes]. So both of the following
+can be true at the same time:
+
+ $ValueType == REG_SZ()
+ $ValueType eq "REG_SZ"
+
+=over
+
+=item REG_SZ and REG_EXPAND_SZ
+
+If the C<FixSzNulls()> option is on, then the trailing C<'\0'> will be
+stripped [unless there isn't one] before values of type C<REG_SZ>
+and C<REG_EXPAND_SZ> are returned. Note that C<SetValue()> will add
+a trailing C<'\0'> under similar circumstances.
+
+=item REG_MULTI_SZ
+
+If the C<SplitMultis()> option is on, then values of this type are
+returned as a reference to an array containing the strings. For
+example, a value that, with C<SplitMultis()> off, would be returned as:
+
+ "Value1\000Value2\000\000"
+
+would be returned, with C<SplitMultis()> on, as:
+
+ [ "Value1", "Value2" ]
+
+=item REG_DWORD
+
+If the C<DualBinVals()> option is on, then the value is returned
+as a scalar containing both a string and a number [much like
+the C<$!> variable -- see the L<SetDualVar> module for more
+information] where the number part is the "unpacked" value.
+Use the returned value in a numeric context to access this part
+of the value. For example:
+
+ $num= 0 + $Registry->{"CUser/Console//ColorTable01"};
+
+If the C<DWordsToHex()> option is off, the string part of the
+returned value is a packed, 4-byte string [use C<unpack("L",$value)>
+to get the numeric value.
+
+If C<DWordsToHex()> is on, the string part of the returned value is
+a 10-character hex strings [with leading "0x"]. You can use
+C<hex($value)> to get the numeric value.
+
+Note that C<SetValue()> will properly understand each of these
+returned value formats no matter how C<DualBinVals()> is set.
+
+=back
+
+=item ValueNames
+
+=item @names= $key->ValueNames
+
+Returns the list of value names stored directly in a Registry key.
+Note that the names returned do I<not> have a delimiter prepended
+to them like with C<MemberNames()> and tied hashes.
+
+Once you request this information, it is cached in the object and
+future requests will always return the same list unless C<Flush()>
+has been called.
+
+=item SubKeyNames
+
+=item @key_names= $key->SubKeyNames
+
+Returns the list of subkey names stored directly in a Registry key.
+Note that the names returned do I<not> have a delimiter appended
+to them like with C<MemberNames()> and tied hashes.
+
+Once you request this information, it is cached in the object and
+future requests will always return the same list unless C<Flush()>
+has been called.
+
+=item SubKeyClasses
+
+=item @classes= $key->SubKeyClasses
+
+Returns the list of classes for subkeys stored directly in a
+Registry key. The classes are returned in the same order as
+the subkey names returned by C<SubKeyNames()>.
+
+=item SubKeyTimes
+
+=item @times= $key->SubKeyTimes
+
+Returns the list of last-modified times for subkeys stored
+directly in a Registry key. The times are returned in the same
+order as the subkey names returned by C<SubKeyNames()>. Each
+time is a C<FILETIME> structure packed into a Perl string.
+
+Once you request this information, it is cached in the object and
+future requests will always return the same list unless C<Flush()>
+has been called.
+
+=item MemberNames
+
+=item @members= $key->MemberNames
+
+Returns the list of subkey names and value names stored directly
+in a Registry key. Subkey names have a delimiter appended to the
+end and value names have a delimiter prepended to the front.
+
+Note that a value name could end in a delimiter [or could be C<"">
+so that the member name returned is just a delimiter] so the
+presence or absence of the leading delimiter is what should be
+used to determine whether a particular name is for a subkey or a
+value, not the presence or absence of a trailing delimiter.
+
+Once you request this information, it is cached in the object and
+future requests will always return the same list unless C<Flush()>
+has been called.
+
+=item Information
+
+=item %info= $key->Information
+
+=item @items= $key->Information( @itemNames );
+
+Returns the following information about a Registry key:
+
+=over
+
+=item LastWrite
+
+A C<FILETIME> structure indicating when the key was last modified
+and packed into a Perl string.
+
+=item CntSubKeys
+
+The number of subkeys stored directly in this key.
+
+=item CntValues
+
+The number of values stored directly in this key.
+
+=item SecurityLen
+
+The length [in bytes] of the largest[?] C<SECURITY_DESCRIPTOR>
+associated with the Registry key.
+
+=item MaxValDataLen
+
+The length [in bytes] of the longest value data associated with
+a value stored in this key.
+
+=item MaxSubKeyLen
+
+The length [in chars] of the longest subkey name associated with
+a subkey stored in this key.
+
+=item MaxSubClassLen
+
+The length [in chars] of the longest class name associated with
+a subkey stored directly in this key.
+
+=item MaxValNameLen
+
+The length [in chars] of the longest value name associated with
+a value stored in this key.
+
+=back
+
+With no arguments, returns a hash [not a reference to a hash] where
+the keys are the names for the items given above and the values
+are the information describe above. For example:
+
+ %info= ( "CntValues" => 25, # Key contains 25 values.
+ "MaxValNameLen" => 20, # One of which has a 20-char name.
+ "MaxValDataLen" => 42, # One of which has a 42-byte value.
+ "CntSubKeys" => 1, # Key has 1 immediate subkey.
+ "MaxSubKeyLen" => 13, # One of which has a 12-char name.
+ "MaxSubClassLen" => 0, # All of which have class names of "".
+ "SecurityLen" => 232, # One SECURITY_DESCRIPTOR is 232 bytes.
+ "LastWrite" => "\x90mZ\cX{\xA3\xBD\cA\c@\cA"
+ # Key was last modifed 1998/06/01 16:29:32 GMT
+ );
+
+With arguments, each one must be the name of a item given above.
+The return value is the information associated with the listed
+names. In other words:
+
+ return $key->Information( @names );
+
+returns the same list as:
+
+ %info= $key->Information;
+ return @info{@names};
+
+=item Delimiter
+
+=item $oldDelim= $key->Delimiter
+
+=item $oldDelim= $key->Delimiter( $newDelim )
+
+Gets and possibly changes the delimiter used for this object. The
+delimiter is appended to subkey names and prepended to value names
+in many return values. It is also used when parsing keys passed
+to tied hashes.
+
+The delimiter defaults to backslash (C<'\\'>) but is inherited from
+the object used to create a new object and can be specified by an
+option when a new object is created.
+
+=item Handle
+
+=item $handle= $key->Handle
+
+Returns the raw C<HKEY> handle for the associated Registry key as
+an integer value. This value can then be used to Reg*() calls
+from I<Win32API::Registry>. However, it is usually easier to just
+call the I<Win32API::Registry> calls directly via:
+
+ $key->RegNotifyChangeKeyValue( ... );
+
+For the virtual root of the local or a remote Registry,
+C<Handle()> return C<"NONE">.
+
+=item Path
+
+=item $path= $key->Path
+
+Returns a string describing the path of key names to this
+Registry key. The string is built so that if it were passed
+to C<< $Registry->Open() >>, it would reopen the same Registry key
+[except in the rare case where one of the key names contains
+C<< $key->Delimiter >>].
+
+=item Machine
+
+=item $computerName= $key->Machine
+
+Returns the name of the computer [or "machine"] on which this Registry
+key resides. Returns C<""> for local Registry keys.
+
+=item Access
+
+Returns the numeric value of the bit mask used to specify the
+types of access requested when this Registry key was opened. Can
+be compared to C<KEY_*> values.
+
+=item OS_Delimiter
+
+Returns the delimiter used by the operating system's RegOpenKeyEx()
+call. For Win32, this is always backslash (C<"\\">).
+
+=item Roots
+
+Returns the mapping from root key names like C<"LMachine"> to their
+associated C<HKEY_*> constants. Primarily for internal use and
+subject to change.
+
+=item Tie
+
+=item $key->Tie( \%hash );
+
+Ties the referenced hash to that Registry key. Pretty much the
+same as
+
+ tie %hash, ref($key), $key;
+
+Since C<ref($key)> is the class [package] to tie the hash to and
+C<TIEHASH()> just returns its argument, C<$key>, [without calling
+C<new()>] when it sees that it is already a blessed object.
+
+=item TiedRef
+
+=item $TiedHashRef= $hash_or_obj_ref->TiedRef
+
+For a simple object, returns a reference to a hash tied to the
+object. Used to promote a simple object into a combined object
+and hash ref.
+
+If already a reference to a tied hash [that is also an object],
+it just returns itself [C<< $ref == $ref->TiedRef >>].
+
+Mostly used internally.
+
+=item ArrayValues
+
+=item $oldBool= $key->ArrayValues
+
+=item $oldBool= $key->ArrayValues( $newBool )
+
+Gets the current setting of the C<ArrayValues> option and possibly
+turns it on or off.
+
+When off, Registry values fetched via a tied hash are returned as
+just a value scalar [the same as C<GetValue()> in a scalar context].
+When on, they are returned as a reference to an array containing
+the value data as the C<[0]> element and the data type as the C<[1]>
+element.
+
+=item TieValues
+
+=item $oldBool= TieValues
+
+=item $oldBool= TieValues( $newBool )
+
+Gets the current setting of the C<TieValues> option and possibly
+turns it on or off.
+
+Turning this option on is not yet supported in this release of
+I<Win32::TieRegistry>. In a future release, turning this option
+on will cause Registry values returned from a tied hash to be
+a tied array that you can use to modify the value in the Registry.
+
+=item FastDelete
+
+=item $oldBool= $key->FastDelete
+
+=item $oldBool= $key->FastDelete( $newBool )
+
+Gets the current setting of the C<FastDelete> option and possibly
+turns it on or off.
+
+When on, successfully deleting a Registry key [via a tied hash]
+simply returns C<1>.
+
+When off, successfully deleting a Registry key [via a tied hash
+and not in a void context] returns a reference to a hash that
+contains the values present in the key when it was deleted. This
+hash is just like that returned when referencing the key before it
+was deleted except that it is an ordinary hash, not one tied to
+the I<Win32::TieRegistry> package.
+
+Note that deleting either a Registry key or value via a tied hash
+I<in a void context> prevents any overhead in trying to build an
+appropriate return value.
+
+Note that deleting a Registry I<value> via a tied hash [not in
+a void context] returns the value data even if <FastDelete> is on.
+
+=item SplitMultis
+
+=item $oldBool= $key->SplitMultis
+
+=item $oldBool= $key->SplitMultis( $newBool )
+
+Gets the current setting of the C<SplitMultis> option and possibly
+turns it on or off.
+
+If on, Registry values of type C<REG_MULTI_SZ> are returned as
+a reference to an array of strings. See C<GetValue()> for more
+information.
+
+=item DWordsToHex
+
+=item $oldBool= $key->DWordsToHex
+
+=item $oldBool= $key->DWordsToHex( $newBool )
+
+Gets the current setting of the C<DWordsToHex> option and possibly
+turns it on or off.
+
+If on, Registry values of type C<REG_DWORD> are returned as a hex
+string with leading C<"0x"> and longer than 4 characters. See
+C<GetValue()> for more information.
+
+=item FixSzNulls
+
+=item $oldBool= $key->FixSzNulls
+
+=item $oldBool= $key->FixSzNulls( $newBool )
+
+Gets the current setting of the C<FixSzNulls> option and possibly
+turns it on or off.
+
+If on, Registry values of type C<REG_SZ> and C<REG_EXPAND_SZ> have
+trailing C<'\0'>s added before they are set and stripped before
+they are returned. See C<GetValue()> and C<SetValue()> for more
+information.
+
+=item DualTypes
+
+=item $oldBool= $key->DualTypes
+
+=item $oldBool= $key->DualTypes( $newBool )
+
+Gets the current setting of the C<DualTypes> option and possibly
+turns it on or off.
+
+If on, data types are returned as a combined numeric/string value
+holding both the numeric value of a C<REG_*> constant and the
+string value of the constant's name. See C<GetValue()> for
+more information.
+
+=item DualBinVals
+
+=item $oldBool= $key->DualBinVals
+
+=item $oldBool= $key->DualBinVals( $newBool )
+
+Gets the current setting of the C<DualBinVals> option and possibly
+turns it on or off.
+
+If on, Registry value data of type C<REG_BINARY> and no more than
+4 bytes long and Registry values of type C<REG_DWORD> are returned
+as a combined numeric/string value where the numeric value is the
+"unpacked" binary value as returned by:
+
+ hex reverse unpack( "h*", $valData )
+
+on a "little-endian" computer. [Would be C<hex unpack("H*",$valData)>
+on a "big-endian" computer if this module is ever ported to one.]
+
+See C<GetValue()> for more information.
+
+=item GetOptions
+
+=item @oldOptValues= $key->GetOptions( @optionNames )
+
+=item $refHashOfOldOpts= $key->GetOptions()
+
+=item $key->GetOptions( \%hashForOldOpts )
+
+Returns the current setting of any of the following options:
+
+ Delimiter FixSzNulls DWordsToHex
+ ArrayValues SplitMultis DualBinVals
+ TieValues FastDelete DualTypes
+
+Pass in one or more of the above names (as strings) to get back
+an array of the corresponding current settings in the same order:
+
+ my( $fastDel, $delim )= $key->GetOptions("FastDelete","Delimiter");
+
+Pass in no arguments to get back a reference to a hash where
+the above option names are the keys and the values are
+the corresponding current settings for each option:
+
+ my $href= $key->GetOptions();
+ my $delim= $href->{Delimiter};
+
+Pass in a single reference to a hash to have the above key/value
+pairs I<added> to the referenced hash. For this case, the
+return value is the original object so further methods can be
+chained after the call to GetOptions:
+
+ my %oldOpts;
+ $key->GetOptions( \%oldOpts )->SetOptions( Delimiter => "/" );
+
+=item SetOptions
+
+=item @oldOpts= $key->SetOptions( optNames=>$optValue,... )
+
+Changes the current setting of any of the following options,
+returning the previous setting(s):
+
+ Delimiter FixSzNulls DWordsToHex AllowLoad
+ ArrayValues SplitMultis DualBinVals AllowSave
+ TieValues FastDelete DualTypes
+
+For C<AllowLoad> and C<AllowSave>, instead of the previous
+setting, C<SetOptions> returns whether or not the change was
+successful.
+
+In a scalar context, returns only the last item. The last
+option can also be specified as C<"ref"> or C<"r"> [which doesn't
+need to be followed by a value] to allow chaining:
+
+ $key->SetOptions(AllowSave=>1,"ref")->RegSaveKey(...)
+
+=item SetValue
+
+=item $okay= $key->SetValue( $ValueName, $ValueData );
+
+=item $okay= $key->SetValue( $ValueName, $ValueData, $ValueType );
+
+Adds or replaces a Registry value. Returns a true value if
+successfully, false otherwise.
+
+C<$ValueName> is the name of the value to add or replace and
+should I<not> have a delimiter prepended to it. Case is ignored.
+
+C<$ValueType> is assumed to be C<REG_SZ> if it is omitted. Otherwise,
+it should be one the C<REG_*> constants.
+
+C<$ValueData> is the data to be stored in the value, probably packed
+into a Perl string. Other supported formats for value data are
+listed below for each possible C<$ValueType>.
+
+=over
+
+=item REG_SZ or REG_EXPAND_SZ
+
+The only special processing for these values is the addition of
+the required trailing C<'\0'> if it is missing. This can be
+turned off by disabling the C<FixSzNulls> option.
+
+=item REG_MULTI_SZ
+
+These values can also be specified as a reference to a list of
+strings. For example, the following two lines are equivalent:
+
+ $key->SetValue( "Val1\000Value2\000LastVal\000\000", "REG_MULTI_SZ" );
+ $key->SetValue( ["Val1","Value2","LastVal"], "REG_MULTI_SZ" );
+
+Note that if the required two trailing nulls (C<"\000\000">) are
+missing, then this release of C<SetValue()> will I<not> add them.
+
+=item REG_DWORD
+
+These values can also be specified as a hex value with the leading
+C<"0x"> included and totaling I<more than> 4 bytes. These will be
+packed into a 4-byte string via:
+
+ $data= pack( "L", hex($data) );
+
+=item REG_BINARY
+
+This value type is listed just to emphasize that no alternate
+format is supported for it. In particular, you should I<not> pass
+in a numeric value for this type of data. C<SetValue()> cannot
+distinguish such from a packed string that just happens to match
+a numeric value and so will treat it as a packed string.
+
+=back
+
+An alternate calling format:
+
+ $okay= $key->SetValue( $ValueName, [ $ValueData, $ValueType ] );
+
+[two arguments, the second of which is a reference to an array
+containing the value data and value type] is supported to ease
+using tied hashes with C<SetValue()>.
+
+=item CreateKey
+
+=item $newKey= $key->CreateKey( $subKey );
+
+=item $newKey= $key->CreateKey( $subKey, { Option=>OptVal,... } );
+
+Creates a Registry key or just updates attributes of one. Calls
+C<RegCreateKeyEx()> then, if it succeeded, creates an object
+associated with the [possibly new] subkey.
+
+C<$subKey> is the name of a subkey [or a path to one] to be
+created or updated. It can also be a reference to an array
+containing a list of subkey names.
+
+The second argument, if it exists, should be a reference to a
+hash specifying options either to be passed to C<RegCreateKeyEx()>
+or to be used when creating the associated object. The following
+items are the supported keys for this options hash:
+
+=over
+
+=item Delimiter
+
+Specifies the delimiter to be used to parse C<$subKey> and to be
+used in the new object. Defaults to C<< $key->Delimiter >>.
+
+=item Access
+
+Specifies the types of access requested when the subkey is opened.
+Should be a numeric bit mask that combines one or more C<KEY_*>
+constant values.
+
+=item Class
+
+The name to assign as the class of the new or updated subkey.
+Defaults to C<""> as we have never seen a use for this information.
+
+=item Disposition
+
+Lets you specify a reference to a scalar where, upon success, will be
+stored either C<REG_CREATED_NEW_KEY()> or C<REG_OPENED_EXISTING_KEY()>
+depending on whether a new key was created or an existing key was
+opened.
+
+If you, for example, did C<use Win32::TieRegistry qw(REG_CREATED_NEW_KEY)>
+then you can use C<REG_CREATED_NEW_KEY()> to compare against the numeric
+value stored in the referenced scalar.
+
+If the C<DualTypes> option is enabled, then in addition to the
+numeric value described above, the referenced scalar will also
+have a string value equal to either C<"REG_CREATED_NEW_KEY"> or
+C<"REG_OPENED_EXISTING_KEY">, as appropriate.
+
+=item Security
+
+Lets you specify a C<SECURITY_ATTRIBUTES> structure packed into a
+Perl string. See C<Win32API::Registry::RegCreateKeyEx()> for more
+information.
+
+=item Volatile
+
+If true, specifies that the new key should be volatile, that is,
+stored only in memory and not backed by a hive file [and not saved
+if the computer is rebooted]. This option is ignored under
+Windows 95. Specifying C<Volatile=E<gt>1> is the same as
+specifying C<Options=E<gt>REG_OPTION_VOLATILE>.
+
+=item Backup
+
+If true, specifies that the new key should be opened for
+backup/restore access. The C<Access> option is ignored. If the
+calling process has enabled C<"SeBackupPrivilege">, then the
+subkey is opened with C<KEY_READ> access as the C<"LocalSystem">
+user which should have access to all subkeys. If the calling
+process has enabled C<"SeRestorePrivilege">, then the subkey is
+opened with C<KEY_WRITE> access as the C<"LocalSystem"> user which
+should have access to all subkeys.
+
+This option is ignored under Windows 95. Specifying C<Backup=E<gt>1>
+is the same as specifying C<Options=E<gt>REG_OPTION_BACKUP_RESTORE>.
+
+=item Options
+
+Lets you specify options to the C<RegOpenKeyEx()> call. The value
+for this option should be a numeric value combining zero or more
+of the C<REG_OPTION_*> bit masks. You may with to used the
+C<Volatile> and/or C<Backup> options instead of this one.
+
+=back
+
+=item StoreKey
+
+=item $newKey= $key->StoreKey( $subKey, \%Contents );
+
+Primarily for internal use.
+
+Used to create or update a Registry key and any number of subkeys
+or values under it or its subkeys.
+
+C<$subKey> is the name of a subkey to be created [or a path of
+subkey names separated by delimiters]. If that subkey already
+exists, then it is updated.
+
+C<\%Contents> is a reference to a hash containing pairs of
+value names with value data and/or subkey names with hash
+references similar to C<\%Contents>. Each of these cause
+a value or subkey of C<$subKey> to be created or updated.
+
+If C<$Contents{""}> exists and is a reference to a hash, then
+it used as the options argument when C<CreateKey()> is called
+for C<$subKey>. This allows you to specify ...
+
+ if( defined( $$data{""} ) && "HASH" eq ref($$data{""}) ) {
+ $self= $this->CreateKey( $subKey, delete $$data{""} );
+
+=item Load
+
+=item $newKey= $key->Load( $file )
+
+=item $newKey= $key->Load( $file, $newSubKey )
+
+=item $newKey= $key->Load( $file, $newSubKey, { Option=>OptVal... } )
+
+=item $newKey= $key->Load( $file, { Option=>OptVal... } )
+
+Loads a hive file into a Registry. That is, creates a new subkey
+and associates a hive file with it.
+
+C<$file> is a hive file, that is a file created by calling
+C<RegSaveKey()>. The C<$file> path is interpreted relative to
+C<%SystemRoot%/System32/config> on the machine where C<$key>
+resides.
+
+C<$newSubKey> is the name to be given to the new subkey. If
+C<$newSubKey> is specified, then C<$key> must be
+C<HKEY_LOCAL_MACHINE> or C<HKEY_USERS> of the local computer
+or a remote computer and C<$newSubKey> should not contain any
+occurrences of either the delimiter or the OS delimiter.
+
+If C<$newSubKey> is not specified, then it is as if C<$key>
+was C<$Registry-E<gt>{LMachine}> and C<$newSubKey> is
+C<"PerlTie:999"> where C<"999"> is actually a sequence number
+incremented each time this process calls C<Load()>.
+
+You can specify as the last argument a reference to a hash
+containing options. You can specify the same options that you
+can specify to C<Open()>. See C<Open()> for more information on
+those. In addition, you can specify the option C<"NewSubKey">.
+The value of this option is interpreted exactly as if it was
+specified as the C<$newSubKey> parameter and overrides the
+C<$newSubKey> if one was specified.
+
+The hive is automatically unloaded when the returned object
+[C<$newKey>] is destroyed. Registry key objects opened within
+the hive will keep a reference to the C<$newKey> object so that
+it will not be destroyed before these keys are closed.
+
+=item UnLoad
+
+=item $okay= $key->UnLoad
+
+Unloads a hive that was loaded via C<Load()>. Cannot unload other
+hives. C<$key> must be the return from a previous call to C<Load()>.
+C<$key> is closed and then the hive is unloaded.
+
+=item AllowSave
+
+=item $okay= AllowSave( $bool )
+
+Enables or disables the C<"ReBackupPrivilege"> privilege for the
+current process. You will probably have to enable this privilege
+before you can use C<RegSaveKey()>.
+
+The return value indicates whether the operation succeeded, not
+whether the privilege was previously enabled.
+
+=item AllowLoad
+
+=item $okay= AllowLoad( $bool )
+
+Enables or disables the C<"ReRestorePrivilege"> privilege for the
+current process. You will probably have to enable this privilege
+before you can use C<RegLoadKey()>, C<RegUnLoadKey()>,
+C<RegReplaceKey()>, or C<RegRestoreKey> and thus C<Load()> and
+C<UnLoad()>.
+
+The return value indicates whether the operation succeeded, not
+whether the privilege was previously enabled.
+
+=back
+
+=head2 Exports [C<use> and C<import()>]
+
+To have nothing imported into your package, use something like:
+
+ use Win32::TieRegistry 0.20 ();
+
+which would verify that you have at least version 0.20 but wouldn't
+call C<import()>. The F<Changes> file can be useful in figuring out
+which, if any, prior versions of I<Win32::TieRegistry> you want to
+support in your script.
+
+The code
+
+ use Win32::TieRegistry;
+
+imports the variable C<$Registry> into your package and sets it
+to be a reference to a hash tied to a copy of the master Registry
+virtual root object with the default options. One disadvantage
+to this "default" usage is that Perl does not support checking
+the module version when you use it.
+
+Alternately, you can specify a list of arguments on the C<use>
+line that will be passed to the C<< Win32::TieRegistry->import() >>
+method to control what items to import into your package. These
+arguments fall into the following broad categories:
+
+=over
+
+=item Import a reference to a hash tied to a Registry virtual root
+
+You can request that a scalar variable be imported (possibly)
+and set to be a reference to a hash tied to a Registry virtual root
+using any of the following types of arguments or argument pairs:
+
+=over
+
+=item "TiedRef", '$scalar'
+
+=item "TiedRef", '$pack::scalar'
+
+=item "TiedRef", 'scalar'
+
+=item "TiedRef", 'pack::scalar'
+
+All of the above import a scalar named C<$scalar> into your package
+(or the package named "pack") and then sets it.
+
+=item '$scalar'
+
+=item '$pack::scalar'
+
+These are equivalent to the previous items to support a more
+traditional appearance to the list of exports. Note that the
+scalar name cannot be "RegObj" here.
+
+=item "TiedRef", \$scalar
+
+=item \$scalar
+
+These versions don't import anything but set the referenced C<$scalar>.
+
+=back
+
+=item Import a hash tied to the Registry virtual root
+
+You can request that a hash variable be imported (possibly)
+and tied to a Registry virtual root using any of the following
+types of arguments or argument pairs:
+
+=over
+
+=item "TiedHash", '%hash'
+
+=item "TiedHash", '%pack::hash'
+
+=item "TiedHash", 'hash'
+
+=item "TiedHash", 'pack::hash'
+
+All of the above import a hash named C<%hash> into your package
+(or the package named "pack") and then sets it.
+
+=item '%hash'
+
+=item '%pack::hash'
+
+These are equivalent to the previous items to support a more
+traditional appearance to the list of exports.
+
+=item "TiedHash", \%hash
+
+=item \%hash
+
+These versions don't import anything but set the referenced C<%hash>.
+
+=back
+
+=item Import a Registry virtual root object
+
+You can request that a scalar variable be imported (possibly)
+and set to be a Registry virtual root object using any of the
+following types of arguments or argument pairs:
+
+=over
+
+=item "ObjectRef", '$scalar'
+
+=item "ObjectRef", '$pack::scalar'
+
+=item "ObjectRef", 'scalar'
+
+=item "ObjectRef", 'pack::scalar'
+
+All of the above import a scalar named C<$scalar> into your package
+(or the package named "pack") and then sets it.
+
+=item '$RegObj'
+
+This is equivalent to the previous items for backward compatibility.
+
+=item "ObjectRef", \$scalar
+
+This version doesn't import anything but sets the referenced C<$scalar>.
+
+=back
+
+=item Import constant(s) exported by I<Win32API::Registry>
+
+You can list any constants that are exported by I<Win32API::Registry>
+to have them imported into your package. These constants have names
+starting with "KEY_" or "REG_" (or even "HKEY_").
+
+You can also specify C<":KEY_">, C<":REG_">, and even C<":HKEY_"> to
+import a whole set of constants.
+
+See I<Win32API::Registry> documentation for more information.
+
+=item Options
+
+You can list any option names that can be listed in the C<SetOptions()>
+method call, each followed by the value to use for that option.
+A Registry virtual root object is created, all of these options are
+set for it, then each variable to be imported/set is associated with
+this object.
+
+In addition, the following special options are supported:
+
+=over
+
+=item ExportLevel
+
+Whether to import variables into your package or some
+package that uses your package. Defaults to the value of
+C<$Exporter::ExportLevel> and has the same meaning. See
+the L<Exporter> module for more information.
+
+=item ExportTo
+
+The name of the package to import variables and constants into.
+Overrides I<ExportLevel>.
+
+=back
+
+=back
+
+=head3 Specifying constants in your Perl code
+
+This module was written with a strong emphasis on the convenience of
+the module user. Therefore, most places where you can specify a
+constant like C<REG_SZ()> also allow you to specify a string
+containing the name of the constant, C<"REG_SZ">. This is convenient
+because you may not have imported that symbolic constant.
+
+Perl also emphasizes programmer convenience so the code C<REG_SZ>
+can be used to mean C<REG_SZ()> or C<"REG_SZ"> or be illegal.
+Note that using C<&REG_SZ> (as we've seen in much Win32 Perl code)
+is not a good idea since it passes the current C<@_> to the
+C<constant()> routine of the module which, at the least, can give
+you a warning under B<-w>.
+
+Although greatly a matter of style, the "safest" practice is probably
+to specifically list all constants in the C<use Win32::TieRegistry>
+statement, specify C<use strict> [or at least C<use strict qw(subs)>],
+and use bare constant names when you want the numeric value. This will
+detect misspelled constant names at compile time.
+
+ use strict;
+ my $Registry;
+ use Win32::TieRegistry 0.20 (
+ TiedRef => \$Registry, Delimiter => "/", ArrayValues => 1,
+ SplitMultis => 1, AllowLoad => 1,
+ qw( REG_SZ REG_EXPAND_SZ REG_DWORD REG_BINARY REG_MULTI_SZ
+ KEY_READ KEY_WRITE KEY_ALL_ACCESS ),
+ );
+ $Registry->{"LMachine/Software/FooCorp/"}= {
+ "FooWriter/" => {
+ "/Fonts" => [ ["Times","Courier","Lucinda"], REG_MULTI_SZ ],
+ "/WindowSize" => [ pack("LL",24,80), REG_BINARY ],
+ "/TaskBarIcon" => [ "0x0001", REG_DWORD ],
+ },
+ } or die "Can't create Software/FooCorp/: $^E\n";
+
+If you don't want to C<use strict qw(subs)>, the second safest practice
+is similar to the above but use the C<REG_SZ()> form for constants
+when possible and quoted constant names when required. Note that
+C<qw()> is a form of quoting.
+
+ use Win32::TieRegistry 0.20 qw(
+ TiedRef $Registry
+ Delimiter / ArrayValues 1 SplitMultis 1 AllowLoad 1
+ REG_SZ REG_EXPAND_SZ REG_DWORD REG_BINARY REG_MULTI_SZ
+ KEY_READ KEY_WRITE KEY_ALL_ACCESS
+ );
+ $Registry->{"LMachine/Software/FooCorp/"}= {
+ "FooWriter/" => {
+ "/Fonts" => [ ["Times","Courier","Lucinda"], REG_MULTI_SZ() ],
+ "/WindowSize" => [ pack("LL",24,80), REG_BINARY() ],
+ "/TaskBarIcon" => [ "0x0001", REG_DWORD() ],
+ },
+ } or die "Can't create Software/FooCorp/: $^E\n";
+
+The examples in this document mostly use quoted constant names
+(C<"REG_SZ">) since that works regardless of which constants
+you imported and whether or not you have C<use strict> in your
+script. It is not the best choice for you to use for real
+scripts (vs. examples) because it is less efficient and is not
+supported by most other similar modules.
+
+=head1 SUMMARY
+
+Most things can be done most easily via tied hashes. Skip down to the
+the L<Tied Hashes Summary> to get started quickly.
+
+=head2 Objects Summary
+
+Here are quick examples that document the most common functionality
+of all of the method functions [except for a few almost useless ones].
+
+ # Just another way of saying Open():
+ $key= Win32::TieRegistry->new("LMachine\\Software\\",
+ { Access=>KEY_READ()|KEY_WRITE(), Delimiter=>"\\" });
+
+ # Open a Registry key:
+ $subKey= $key->Open( "SubKey/SubSubKey/",
+ { Access=>KEY_ALL_ACCESS, Delimiter=>"/" } );
+
+ # Connect to a remote Registry key:
+ $remKey= $Registry->Connect( "MachineName", "LMachine/",
+ { Access=>KEY_READ, Delimiter=>"/" } );
+
+ # Get value data:
+ $valueString= $key->GetValue("ValueName");
+ ( $valueString, $valueType )= $key->GetValue("ValueName");
+
+ # Get list of value names:
+ @valueNames= $key->ValueNames;
+
+ # Get list of subkey names:
+ @subKeyNames= $key->SubKeyNames;
+
+ # Get combined list of value names (with leading delimiters)
+ # and subkey names (with trailing delimiters):
+ @memberNames= $key->MemberNames;
+
+ # Get all information about a key:
+ %keyInfo= $key->Information;
+ # keys(%keyInfo)= qw( Class LastWrite SecurityLen
+ # CntSubKeys MaxSubKeyLen MaxSubClassLen
+ # CntValues MaxValNameLen MaxValDataLen );
+
+ # Get selected information about a key:
+ ( $class, $cntSubKeys )= $key->Information( "Class", "CntSubKeys" );
+
+ # Get and/or set delimiter:
+ $delim= $key->Delimiter;
+ $oldDelim= $key->Delimiter( $newDelim );
+
+ # Get "path" for an open key:
+ $path= $key->Path;
+ # For example, "/CUser/Control Panel/Mouse/"
+ # or "//HostName/LMachine/System/DISK/".
+
+ # Get name of machine where key is from:
+ $mach= $key->Machine;
+ # Will usually be "" indicating key is on local machine.
+
+ # Control different options (see main documentation for descriptions):
+ $oldBool= $key->ArrayValues( $newBool );
+ $oldBool= $key->FastDelete( $newBool );
+ $oldBool= $key->FixSzNulls( $newBool );
+ $oldBool= $key->SplitMultis( $newBool );
+ $oldBool= $key->DWordsToHex( $newBool );
+ $oldBool= $key->DualBinVals( $newBool );
+ $oldBool= $key->DualTypes( $newBool );
+ @oldBools= $key->SetOptions( ArrayValues=>1, FastDelete=>1, FixSzNulls=>0,
+ Delimiter=>"/", AllowLoad=>1, AllowSave=>1 );
+ @oldBools= $key->GetOptions( ArrayValues, FastDelete, FixSzNulls );
+
+ # Add or set a value:
+ $key->SetValue( "ValueName", $valueDataString );
+ $key->SetValue( "ValueName", pack($format,$valueData), "REG_BINARY" );
+
+ # Add or set a key:
+ $key->CreateKey( "SubKeyName" );
+ $key->CreateKey( "SubKeyName",
+ { Access=>"KEY_ALL_ACCESS", Class=>"ClassName",
+ Delimiter=>"/", Volatile=>1, Backup=>1 } );
+
+ # Load an off-line Registry hive file into the on-line Registry:
+ $newKey= $Registry->Load( "C:/Path/To/Hive/FileName" );
+ $newKey= $key->Load( "C:/Path/To/Hive/FileName", "NewSubKeyName",
+ { Access=>"KEY_READ" } );
+ # Unload a Registry hive file loaded via the Load() method:
+ $newKey->UnLoad;
+
+ # (Dis)Allow yourself to load Registry hive files:
+ $success= $Registry->AllowLoad( $bool );
+
+ # (Dis)Allow yourself to save a Registry key to a hive file:
+ $success= $Registry->AllowSave( $bool );
+
+ # Save a Registry key to a new hive file:
+ $key->RegSaveKey( "C:/Path/To/Hive/FileName", [] );
+
+=head3 Other Useful Methods
+
+See I<Win32API::Registry> for more information on these methods.
+These methods are provided for coding convenience and are
+identical to the I<Win32API::Registry> functions except that these
+don't take a handle to a Registry key, instead getting the handle
+from the invoking object [C<$key>].
+
+ $key->RegGetKeySecurity( $iSecInfo, $sSecDesc, $lenSecDesc );
+ $key->RegLoadKey( $sSubKeyName, $sPathToFile );
+ $key->RegNotifyChangeKeyValue(
+ $bWatchSubtree, $iNotifyFilter, $hEvent, $bAsync );
+ $key->RegQueryMultipleValues(
+ $structValueEnts, $cntValueEnts, $Buffer, $lenBuffer );
+ $key->RegReplaceKey( $sSubKeyName, $sPathToNewFile, $sPathToBackupFile );
+ $key->RegRestoreKey( $sPathToFile, $iFlags );
+ $key->RegSetKeySecurity( $iSecInfo, $sSecDesc );
+ $key->RegUnLoadKey( $sSubKeyName );
+
+=head2 Tied Hashes Summary
+
+For fast learners, this may be the only section you need to read.
+Always append one delimiter to the end of each Registry key name
+and prepend one delimiter to the front of each Registry value name.
+
+=head3 Opening keys
+
+ use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1 );
+ $Registry->Delimiter("/"); # Set delimiter to "/".
+ $swKey= $Registry->{"LMachine/Software/"};
+ $winKey= $swKey->{"Microsoft/Windows/CurrentVersion/"};
+ $userKey= $Registry->
+ {"CUser/Software/Microsoft/Windows/CurrentVersion/"};
+ $remoteKey= $Registry->{"//HostName/LMachine/"};
+
+=head3 Reading values
+
+ $progDir= $winKey->{"/ProgramFilesDir"}; # "C:\\Program Files"
+ $tip21= $winKey->{"Explorer/Tips//21"}; # Text of tip #21.
+
+ $winKey->ArrayValues(1);
+ ( $devPath, $type )= $winKey->{"/DevicePath"};
+ # $devPath eq "%SystemRoot%\\inf"
+ # $type eq "REG_EXPAND_SZ" [if you have SetDualVar.pm installed]
+ # $type == REG_EXPAND_SZ() [if did C<use Win32::TieRegistry qw(:REG_)>]
+
+=head3 Setting values
+
+ $winKey->{"Setup//SourcePath"}= "\\\\SwServer\\SwShare\\Windows";
+ # Simple. Assumes data type of REG_SZ.
+
+ $winKey->{"Setup//Installation Sources"}=
+ [ "D:\x00\\\\SwServer\\SwShare\\Windows\0\0", "REG_MULTI_SZ" ];
+ # "\x00" and "\0" used to mark ends of each string and end of list.
+
+ $winKey->{"Setup//Installation Sources"}=
+ [ ["D:","\\\\SwServer\\SwShare\\Windows"], "REG_MULTI_SZ" ];
+ # Alternate method that is easier to read.
+
+ $userKey->{"Explorer/Tips//DisplayInitialTipWindow"}=
+ [ pack("L",0), "REG_DWORD" ];
+ $userKey->{"Explorer/Tips//Next"}= [ pack("S",3), "REG_BINARY" ];
+ $userKey->{"Explorer/Tips//Show"}= [ pack("L",0), "REG_BINARY" ];
+
+=head3 Adding keys
+
+ $swKey->{"FooCorp/"}= {
+ "FooWriter/" => {
+ "/Version" => "4.032",
+ "Startup/" => {
+ "/Title" => "Foo Writer Deluxe ][",
+ "/WindowSize" => [ pack("LL",$wid,$ht), "REG_BINARY" ],
+ "/TaskBarIcon" => [ "0x0001", "REG_DWORD" ],
+ },
+ "Compatibility/" => {
+ "/AutoConvert" => "Always",
+ "/Default Palette" => "Windows Colors",
+ },
+ },
+ "/License", => "0123-9C8EF1-09-FC",
+ };
+
+=head3 Listing all subkeys and values
+
+ @members= keys( %{$swKey} );
+ @subKeys= grep( m#^/#, keys( %{$swKey->{"Classes/batfile/"}} ) );
+ # @subKeys= ( "/", "/EditFlags" );
+ @valueNames= grep( ! m#^/#, keys( %{$swKey->{"Classes/batfile/"}} ) );
+ # @valueNames= ( "DefaultIcon/", "shell/", "shellex/" );
+
+=head3 Deleting values or keys with no subkeys
+
+ $oldValue= delete $userKey->{"Explorer/Tips//Next"};
+
+ $oldValues= delete $userKey->{"Explorer/Tips/"};
+ # $oldValues will be reference to hash containing deleted keys values.
+
+=head3 Closing keys
+
+ undef $swKey; # Explicit way to close a key.
+ $winKey= "Anything else"; # Implicitly closes a key.
+ exit 0; # Implicitly closes all keys.
+
+=head2 Tie::Registry
+
+This module was originally called I<Tie::Registry>. Changing code
+that used I<Tie::Registry> over to I<Win32::TieRegistry> is trivial
+as the module name should only be mentioned once, in the C<use>
+line. However, finding all of the places that used I<Tie::Registry>
+may not be completely trivial so we have included F<Tie/Registry.pm>
+which you can install to provide backward compatibility.
+
+=head1 AUTHOR
+
+Tye McQueen. See http://www.metronet.com/~tye/ or e-mail
+tye@metronet.com with bug reports.
+
+=head1 SEE ALSO
+
+I<Win32API::Registry> - Provides access to C<Reg*()>, C<HKEY_*>,
+C<KEY_*>, C<REG_*> [required].
+
+I<Win32::WinError> - Defines C<ERROR_*> values [optional].
+
+L<SetDualVar> - For returning C<REG_*> values as combined
+string/integer values [optional].
+
+=head1 BUGS
+
+Because Perl hashes are case sensitive, certain lookups are also
+case sensitive. In particular, the root keys ("Classes", "CUser",
+"LMachine", "Users", "PerfData", "CConfig", "DynData", and HKEY_*)
+must always be entered without changing between upper and lower
+case letters. Also, the special rule for matching subkey names
+that contain the user-selected delimiter only works if case is
+matched. All other key name and value name lookups should be case
+insensitive because the underlying Reg*() calls ignore case.
+
+Information about each key is cached when using a tied hash.
+This cache is not flushed nor updated when changes are made,
+I<even when the same tied hash is used> to make the changes.
+
+Current implementations of Perl's "global destruction" phase can
+cause objects returned by C<Load()> to be destroyed while keys
+within the hive are still open, if the objects still exist when
+the script starts to exit. When this happens, the automatic
+C<UnLoad()> will report a failure and the hive will remain loaded
+in the Registry.
+
+Trying to C<Load()> a hive file that is located on a remote network
+share may silently delete all data from the hive. This is a bug
+in the Win32 APIs, not any Perl code or modules. This module does
+not try to protect you from this bug.
+
+There is no test suite.
+
+=head1 FUTURE DIRECTIONS
+
+The following items are desired by the author and may appear in a
+future release of this module.
+
+=over
+
+=item TieValues option
+
+Currently described in main documentation but no yet implemented.
+
+=item AutoRefresh option
+
+Trigger use of C<RegNotifyChangeKeyValue()> to keep tied hash
+caches up-to-date even when other programs make changes.
+
+=item Error options
+
+Allow the user to have unchecked calls (calls in a "void context")
+to automatically report errors via C<warn> or C<die>.
+
+For complex operations, such a copying an entire subtree, provide
+access to detailed information about errors (and perhaps some
+warnings) that were encountered. Let the user control whether
+the complex operation continues in spite of errors.
+
+=back
+
+=head1 COPYRIGHT
+
+Copyright 1999 - 2006 Tye McQueen.
+
+Some parts copyright 2007 - 2009 Adam Kennedy.
+
+This program is free software; you can redistribute it and/or modify it
+under the same terms as Perl itself.
+
+=cut
+
+# Autoload not currently supported by Perl under Windows.
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/WinError.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/WinError.pm
new file mode 100644
index 0000000000..c61347b6ec
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32/WinError.pm
@@ -0,0 +1,1017 @@
+package Win32::WinError;
+
+require Exporter;
+require DynaLoader;
+
+$VERSION = '0.04';
+
+@ISA = qw(Exporter DynaLoader);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+@EXPORT = qw(
+ GetLastError
+ CACHE_E_FIRST
+ CACHE_E_LAST
+ CACHE_E_NOCACHE_UPDATED
+ CACHE_S_FIRST
+ CACHE_S_FORMATETC_NOTSUPPORTED
+ CACHE_S_LAST
+ CACHE_S_SAMECACHE
+ CACHE_S_SOMECACHES_NOTUPDATED
+ CLASSFACTORY_E_FIRST
+ CLASSFACTORY_E_LAST
+ CLASSFACTORY_S_FIRST
+ CLASSFACTORY_S_LAST
+ CLASS_E_CLASSNOTAVAILABLE
+ CLASS_E_NOAGGREGATION
+ CLIENTSITE_E_FIRST
+ CLIENTSITE_E_LAST
+ CLIENTSITE_S_FIRST
+ CLIENTSITE_S_LAST
+ CLIPBRD_E_BAD_DATA
+ CLIPBRD_E_CANT_CLOSE
+ CLIPBRD_E_CANT_EMPTY
+ CLIPBRD_E_CANT_OPEN
+ CLIPBRD_E_CANT_SET
+ CLIPBRD_E_FIRST
+ CLIPBRD_E_LAST
+ CLIPBRD_S_FIRST
+ CLIPBRD_S_LAST
+ CONVERT10_E_FIRST
+ CONVERT10_E_LAST
+ CONVERT10_E_OLESTREAM_BITMAP_TO_DIB
+ CONVERT10_E_OLESTREAM_FMT
+ CONVERT10_E_OLESTREAM_GET
+ CONVERT10_E_OLESTREAM_PUT
+ CONVERT10_E_STG_DIB_TO_BITMAP
+ CONVERT10_E_STG_FMT
+ CONVERT10_E_STG_NO_STD_STREAM
+ CONVERT10_S_FIRST
+ CONVERT10_S_LAST
+ CONVERT10_S_NO_PRESENTATION
+ CO_E_ALREADYINITIALIZED
+ CO_E_APPDIDNTREG
+ CO_E_APPNOTFOUND
+ CO_E_APPSINGLEUSE
+ CO_E_BAD_PATH
+ CO_E_CANTDETERMINECLASS
+ CO_E_CLASSSTRING
+ CO_E_CLASS_CREATE_FAILED
+ CO_E_DLLNOTFOUND
+ CO_E_ERRORINAPP
+ CO_E_ERRORINDLL
+ CO_E_FIRST
+ CO_E_IIDSTRING
+ CO_E_INIT_CLASS_CACHE
+ CO_E_INIT_MEMORY_ALLOCATOR
+ CO_E_INIT_ONLY_SINGLE_THREADED
+ CO_E_INIT_RPC_CHANNEL
+ CO_E_INIT_SCM_EXEC_FAILURE
+ CO_E_INIT_SCM_FILE_MAPPING_EXISTS
+ CO_E_INIT_SCM_MAP_VIEW_OF_FILE
+ CO_E_INIT_SCM_MUTEX_EXISTS
+ CO_E_INIT_SHARED_ALLOCATOR
+ CO_E_INIT_TLS
+ CO_E_INIT_TLS_CHANNEL_CONTROL
+ CO_E_INIT_TLS_SET_CHANNEL_CONTROL
+ CO_E_INIT_UNACCEPTED_USER_ALLOCATOR
+ CO_E_LAST
+ CO_E_NOTINITIALIZED
+ CO_E_OBJISREG
+ CO_E_OBJNOTCONNECTED
+ CO_E_OBJNOTREG
+ CO_E_OBJSRV_RPC_FAILURE
+ CO_E_RELEASED
+ CO_E_SCM_ERROR
+ CO_E_SCM_RPC_FAILURE
+ CO_E_SERVER_EXEC_FAILURE
+ CO_E_SERVER_STOPPING
+ CO_E_WRONGOSFORAPP
+ CO_S_FIRST
+ CO_S_LAST
+ DATA_E_FIRST
+ DATA_E_LAST
+ DATA_S_FIRST
+ DATA_S_LAST
+ DATA_S_SAMEFORMATETC
+ DISP_E_ARRAYISLOCKED
+ DISP_E_BADCALLEE
+ DISP_E_BADINDEX
+ DISP_E_BADPARAMCOUNT
+ DISP_E_BADVARTYPE
+ DISP_E_EXCEPTION
+ DISP_E_MEMBERNOTFOUND
+ DISP_E_NONAMEDARGS
+ DISP_E_NOTACOLLECTION
+ DISP_E_OVERFLOW
+ DISP_E_PARAMNOTFOUND
+ DISP_E_PARAMNOTOPTIONAL
+ DISP_E_TYPEMISMATCH
+ DISP_E_UNKNOWNINTERFACE
+ DISP_E_UNKNOWNLCID
+ DISP_E_UNKNOWNNAME
+ DRAGDROP_E_ALREADYREGISTERED
+ DRAGDROP_E_FIRST
+ DRAGDROP_E_INVALIDHWND
+ DRAGDROP_E_LAST
+ DRAGDROP_E_NOTREGISTERED
+ DRAGDROP_S_CANCEL
+ DRAGDROP_S_DROP
+ DRAGDROP_S_FIRST
+ DRAGDROP_S_LAST
+ DRAGDROP_S_USEDEFAULTCURSORS
+ DV_E_CLIPFORMAT
+ DV_E_DVASPECT
+ DV_E_DVTARGETDEVICE
+ DV_E_DVTARGETDEVICE_SIZE
+ DV_E_FORMATETC
+ DV_E_LINDEX
+ DV_E_NOIVIEWOBJECT
+ DV_E_STATDATA
+ DV_E_STGMEDIUM
+ DV_E_TYMED
+ ENUM_E_FIRST
+ ENUM_E_LAST
+ ENUM_S_FIRST
+ ENUM_S_LAST
+ EPT_S_CANT_CREATE
+ EPT_S_CANT_PERFORM_OP
+ EPT_S_INVALID_ENTRY
+ EPT_S_NOT_REGISTERED
+ ERROR_ACCESS_DENIED
+ ERROR_ACCOUNT_DISABLED
+ ERROR_ACCOUNT_EXPIRED
+ ERROR_ACCOUNT_LOCKED_OUT
+ ERROR_ACCOUNT_RESTRICTION
+ ERROR_ACTIVE_CONNECTIONS
+ ERROR_ADAP_HDW_ERR
+ ERROR_ADDRESS_ALREADY_ASSOCIATED
+ ERROR_ADDRESS_NOT_ASSOCIATED
+ ERROR_ALIAS_EXISTS
+ ERROR_ALLOTTED_SPACE_EXCEEDED
+ ERROR_ALREADY_ASSIGNED
+ ERROR_ALREADY_EXISTS
+ ERROR_ALREADY_REGISTERED
+ ERROR_ALREADY_RUNNING_LKG
+ ERROR_ALREADY_WAITING
+ ERROR_ARENA_TRASHED
+ ERROR_ARITHMETIC_OVERFLOW
+ ERROR_ATOMIC_LOCKS_NOT_SUPPORTED
+ ERROR_AUTODATASEG_EXCEEDS_64k
+ ERROR_BADDB
+ ERROR_BADKEY
+ ERROR_BAD_ARGUMENTS
+ ERROR_BAD_COMMAND
+ ERROR_BAD_DESCRIPTOR_FORMAT
+ ERROR_BAD_DEVICE
+ ERROR_BAD_DEV_TYPE
+ ERROR_BAD_DRIVER
+ ERROR_BAD_DRIVER_LEVEL
+ ERROR_BAD_ENVIRONMENT
+ ERROR_BAD_EXE_FORMAT
+ ERROR_BAD_FORMAT
+ ERROR_BAD_IMPERSONATION_LEVEL
+ ERROR_BAD_INHERITANCE_ACL
+ ERROR_BAD_LENGTH
+ ERROR_BAD_LOGON_SESSION_STATE
+ ERROR_BAD_NETPATH
+ ERROR_BAD_NET_NAME
+ ERROR_BAD_NET_RESP
+ ERROR_BAD_PATHNAME
+ ERROR_BAD_PIPE
+ ERROR_BAD_PROFILE
+ ERROR_BAD_PROVIDER
+ ERROR_BAD_REM_ADAP
+ ERROR_BAD_THREADID_ADDR
+ ERROR_BAD_TOKEN_TYPE
+ ERROR_BAD_UNIT
+ ERROR_BAD_USERNAME
+ ERROR_BAD_VALIDATION_CLASS
+ ERROR_BEGINNING_OF_MEDIA
+ ERROR_BOOT_ALREADY_ACCEPTED
+ ERROR_BROKEN_PIPE
+ ERROR_BUFFER_OVERFLOW
+ ERROR_BUSY
+ ERROR_BUSY_DRIVE
+ ERROR_BUS_RESET
+ ERROR_CALL_NOT_IMPLEMENTED
+ ERROR_CANCELLED
+ ERROR_CANCEL_VIOLATION
+ ERROR_CANNOT_COPY
+ ERROR_CANNOT_FIND_WND_CLASS
+ ERROR_CANNOT_IMPERSONATE
+ ERROR_CANNOT_MAKE
+ ERROR_CANNOT_OPEN_PROFILE
+ ERROR_CANTOPEN
+ ERROR_CANTREAD
+ ERROR_CANTWRITE
+ ERROR_CANT_ACCESS_DOMAIN_INFO
+ ERROR_CANT_DISABLE_MANDATORY
+ ERROR_CANT_OPEN_ANONYMOUS
+ ERROR_CAN_NOT_COMPLETE
+ ERROR_CAN_NOT_DEL_LOCAL_WINS
+ ERROR_CHILD_MUST_BE_VOLATILE
+ ERROR_CHILD_NOT_COMPLETE
+ ERROR_CHILD_WINDOW_MENU
+ ERROR_CIRCULAR_DEPENDENCY
+ ERROR_CLASS_ALREADY_EXISTS
+ ERROR_CLASS_DOES_NOT_EXIST
+ ERROR_CLASS_HAS_WINDOWS
+ ERROR_CLIPBOARD_NOT_OPEN
+ ERROR_CLIPPING_NOT_SUPPORTED
+ ERROR_CONNECTION_ABORTED
+ ERROR_CONNECTION_ACTIVE
+ ERROR_CONNECTION_COUNT_LIMIT
+ ERROR_CONNECTION_INVALID
+ ERROR_CONNECTION_REFUSED
+ ERROR_CONNECTION_UNAVAIL
+ ERROR_CONTROL_ID_NOT_FOUND
+ ERROR_COUNTER_TIMEOUT
+ ERROR_CRC
+ ERROR_CURRENT_DIRECTORY
+ ERROR_DATABASE_DOES_NOT_EXIST
+ ERROR_DC_NOT_FOUND
+ ERROR_DEPENDENT_SERVICES_RUNNING
+ ERROR_DESTROY_OBJECT_OF_OTHER_THREAD
+ ERROR_DEVICE_ALREADY_REMEMBERED
+ ERROR_DEVICE_IN_USE
+ ERROR_DEVICE_NOT_PARTITIONED
+ ERROR_DEV_NOT_EXIST
+ ERROR_DIRECTORY
+ ERROR_DIRECT_ACCESS_HANDLE
+ ERROR_DIR_NOT_EMPTY
+ ERROR_DIR_NOT_ROOT
+ ERROR_DISCARDED
+ ERROR_DISK_CHANGE
+ ERROR_DISK_CORRUPT
+ ERROR_DISK_FULL
+ ERROR_DISK_OPERATION_FAILED
+ ERROR_DISK_RECALIBRATE_FAILED
+ ERROR_DISK_RESET_FAILED
+ ERROR_DLL_INIT_FAILED
+ ERROR_DOMAIN_CONTROLLER_NOT_FOUND
+ ERROR_DOMAIN_EXISTS
+ ERROR_DOMAIN_LIMIT_EXCEEDED
+ ERROR_DOMAIN_TRUST_INCONSISTENT
+ ERROR_DRIVE_LOCKED
+ ERROR_DUPLICATE_SERVICE_NAME
+ ERROR_DUP_DOMAINNAME
+ ERROR_DUP_NAME
+ ERROR_DYNLINK_FROM_INVALID_RING
+ ERROR_EAS_DIDNT_FIT
+ ERROR_EAS_NOT_SUPPORTED
+ ERROR_EA_ACCESS_DENIED
+ ERROR_EA_FILE_CORRUPT
+ ERROR_EA_LIST_INCONSISTENT
+ ERROR_EA_TABLE_FULL
+ ERROR_END_OF_MEDIA
+ ERROR_ENVVAR_NOT_FOUND
+ ERROR_EOM_OVERFLOW
+ ERROR_EVENTLOG_CANT_START
+ ERROR_EVENTLOG_FILE_CHANGED
+ ERROR_EVENTLOG_FILE_CORRUPT
+ ERROR_EXCEPTION_IN_SERVICE
+ ERROR_EXCL_SEM_ALREADY_OWNED
+ ERROR_EXE_MARKED_INVALID
+ ERROR_EXTENDED_ERROR
+ ERROR_FAILED_SERVICE_CONTROLLER_CONNECT
+ ERROR_FAIL_I24
+ ERROR_FILEMARK_DETECTED
+ ERROR_FILENAME_EXCED_RANGE
+ ERROR_FILE_CORRUPT
+ ERROR_FILE_EXISTS
+ ERROR_FILE_INVALID
+ ERROR_FILE_NOT_FOUND
+ ERROR_FLOPPY_BAD_REGISTERS
+ ERROR_FLOPPY_ID_MARK_NOT_FOUND
+ ERROR_FLOPPY_UNKNOWN_ERROR
+ ERROR_FLOPPY_WRONG_CYLINDER
+ ERROR_FULLSCREEN_MODE
+ ERROR_FULL_BACKUP
+ ERROR_GENERIC_NOT_MAPPED
+ ERROR_GEN_FAILURE
+ ERROR_GLOBAL_ONLY_HOOK
+ ERROR_GRACEFUL_DISCONNECT
+ ERROR_GROUP_EXISTS
+ ERROR_HANDLE_DISK_FULL
+ ERROR_HANDLE_EOF
+ ERROR_HOOK_NEEDS_HMOD
+ ERROR_HOOK_NOT_INSTALLED
+ ERROR_HOST_UNREACHABLE
+ ERROR_HOTKEY_ALREADY_REGISTERED
+ ERROR_HOTKEY_NOT_REGISTERED
+ ERROR_HWNDS_HAVE_DIFF_PARENT
+ ERROR_ILL_FORMED_PASSWORD
+ ERROR_INCORRECT_ADDRESS
+ ERROR_INC_BACKUP
+ ERROR_INFLOOP_IN_RELOC_CHAIN
+ ERROR_INSUFFICIENT_BUFFER
+ ERROR_INTERNAL_DB_CORRUPTION
+ ERROR_INTERNAL_DB_ERROR
+ ERROR_INTERNAL_ERROR
+ ERROR_INVALID_ACCEL_HANDLE
+ ERROR_INVALID_ACCESS
+ ERROR_INVALID_ACCOUNT_NAME
+ ERROR_INVALID_ACL
+ ERROR_INVALID_ADDRESS
+ ERROR_INVALID_AT_INTERRUPT_TIME
+ ERROR_INVALID_BLOCK
+ ERROR_INVALID_BLOCK_LENGTH
+ ERROR_INVALID_CATEGORY
+ ERROR_INVALID_COMBOBOX_MESSAGE
+ ERROR_INVALID_COMPUTERNAME
+ ERROR_INVALID_CURSOR_HANDLE
+ ERROR_INVALID_DATA
+ ERROR_INVALID_DATATYPE
+ ERROR_INVALID_DOMAINNAME
+ ERROR_INVALID_DOMAIN_ROLE
+ ERROR_INVALID_DOMAIN_STATE
+ ERROR_INVALID_DRIVE
+ ERROR_INVALID_DWP_HANDLE
+ ERROR_INVALID_EA_HANDLE
+ ERROR_INVALID_EA_NAME
+ ERROR_INVALID_EDIT_HEIGHT
+ ERROR_INVALID_ENVIRONMENT
+ ERROR_INVALID_EVENTNAME
+ ERROR_INVALID_EVENT_COUNT
+ ERROR_INVALID_EXE_SIGNATURE
+ ERROR_INVALID_FILTER_PROC
+ ERROR_INVALID_FLAGS
+ ERROR_INVALID_FLAG_NUMBER
+ ERROR_INVALID_FORM_NAME
+ ERROR_INVALID_FORM_SIZE
+ ERROR_INVALID_FUNCTION
+ ERROR_INVALID_GROUPNAME
+ ERROR_INVALID_GROUP_ATTRIBUTES
+ ERROR_INVALID_GW_COMMAND
+ ERROR_INVALID_HANDLE
+ ERROR_INVALID_HOOK_FILTER
+ ERROR_INVALID_HOOK_HANDLE
+ ERROR_INVALID_ICON_HANDLE
+ ERROR_INVALID_ID_AUTHORITY
+ ERROR_INVALID_INDEX
+ ERROR_INVALID_LB_MESSAGE
+ ERROR_INVALID_LEVEL
+ ERROR_INVALID_LIST_FORMAT
+ ERROR_INVALID_LOGON_HOURS
+ ERROR_INVALID_LOGON_TYPE
+ ERROR_INVALID_MEMBER
+ ERROR_INVALID_MENU_HANDLE
+ ERROR_INVALID_MESSAGE
+ ERROR_INVALID_MESSAGEDEST
+ ERROR_INVALID_MESSAGENAME
+ ERROR_INVALID_MINALLOCSIZE
+ ERROR_INVALID_MODULETYPE
+ ERROR_INVALID_MSGBOX_STYLE
+ ERROR_INVALID_NAME
+ ERROR_INVALID_NETNAME
+ ERROR_INVALID_ORDINAL
+ ERROR_INVALID_OWNER
+ ERROR_INVALID_PARAMETER
+ ERROR_INVALID_PASSWORD
+ ERROR_INVALID_PASSWORDNAME
+ ERROR_INVALID_PIXEL_FORMAT
+ ERROR_INVALID_PRIMARY_GROUP
+ ERROR_INVALID_PRINTER_COMMAND
+ ERROR_INVALID_PRINTER_NAME
+ ERROR_INVALID_PRINTER_STATE
+ ERROR_INVALID_PRIORITY
+ ERROR_INVALID_SCROLLBAR_RANGE
+ ERROR_INVALID_SECURITY_DESCR
+ ERROR_INVALID_SEGDPL
+ ERROR_INVALID_SEGMENT_NUMBER
+ ERROR_INVALID_SEPARATOR_FILE
+ ERROR_INVALID_SERVER_STATE
+ ERROR_INVALID_SERVICENAME
+ ERROR_INVALID_SERVICE_ACCOUNT
+ ERROR_INVALID_SERVICE_CONTROL
+ ERROR_INVALID_SERVICE_LOCK
+ ERROR_INVALID_SHARENAME
+ ERROR_INVALID_SHOWWIN_COMMAND
+ ERROR_INVALID_SID
+ ERROR_INVALID_SIGNAL_NUMBER
+ ERROR_INVALID_SPI_VALUE
+ ERROR_INVALID_STACKSEG
+ ERROR_INVALID_STARTING_CODESEG
+ ERROR_INVALID_SUB_AUTHORITY
+ ERROR_INVALID_TARGET_HANDLE
+ ERROR_INVALID_THREAD_ID
+ ERROR_INVALID_TIME
+ ERROR_INVALID_USER_BUFFER
+ ERROR_INVALID_VERIFY_SWITCH
+ ERROR_INVALID_WINDOW_HANDLE
+ ERROR_INVALID_WINDOW_STYLE
+ ERROR_INVALID_WORKSTATION
+ ERROR_IOPL_NOT_ENABLED
+ ERROR_IO_DEVICE
+ ERROR_IO_INCOMPLETE
+ ERROR_IO_PENDING
+ ERROR_IRQ_BUSY
+ ERROR_IS_JOINED
+ ERROR_IS_JOIN_PATH
+ ERROR_IS_JOIN_TARGET
+ ERROR_IS_SUBSTED
+ ERROR_IS_SUBST_PATH
+ ERROR_IS_SUBST_TARGET
+ ERROR_ITERATED_DATA_EXCEEDS_64k
+ ERROR_JOIN_TO_JOIN
+ ERROR_JOIN_TO_SUBST
+ ERROR_JOURNAL_HOOK_SET
+ ERROR_KEY_DELETED
+ ERROR_KEY_HAS_CHILDREN
+ ERROR_LABEL_TOO_LONG
+ ERROR_LAST_ADMIN
+ ERROR_LB_WITHOUT_TABSTOPS
+ ERROR_LISTBOX_ID_NOT_FOUND
+ ERROR_LM_CROSS_ENCRYPTION_REQUIRED
+ ERROR_LOCAL_USER_SESSION_KEY
+ ERROR_LOCKED
+ ERROR_LOCK_FAILED
+ ERROR_LOCK_VIOLATION
+ ERROR_LOGIN_TIME_RESTRICTION
+ ERROR_LOGIN_WKSTA_RESTRICTION
+ ERROR_LOGON_FAILURE
+ ERROR_LOGON_NOT_GRANTED
+ ERROR_LOGON_SESSION_COLLISION
+ ERROR_LOGON_SESSION_EXISTS
+ ERROR_LOGON_TYPE_NOT_GRANTED
+ ERROR_LOG_FILE_FULL
+ ERROR_LUIDS_EXHAUSTED
+ ERROR_MAPPED_ALIGNMENT
+ ERROR_MAX_THRDS_REACHED
+ ERROR_MEDIA_CHANGED
+ ERROR_MEMBERS_PRIMARY_GROUP
+ ERROR_MEMBER_IN_ALIAS
+ ERROR_MEMBER_IN_GROUP
+ ERROR_MEMBER_NOT_IN_ALIAS
+ ERROR_MEMBER_NOT_IN_GROUP
+ ERROR_METAFILE_NOT_SUPPORTED
+ ERROR_META_EXPANSION_TOO_LONG
+ ERROR_MOD_NOT_FOUND
+ ERROR_MORE_DATA
+ ERROR_MORE_WRITES
+ ERROR_MR_MID_NOT_FOUND
+ ERROR_NEGATIVE_SEEK
+ ERROR_NESTING_NOT_ALLOWED
+ ERROR_NETLOGON_NOT_STARTED
+ ERROR_NETNAME_DELETED
+ ERROR_NETWORK_ACCESS_DENIED
+ ERROR_NETWORK_BUSY
+ ERROR_NETWORK_UNREACHABLE
+ ERROR_NET_WRITE_FAULT
+ ERROR_NOACCESS
+ ERROR_NOLOGON_INTERDOMAIN_TRUST_ACCOUNT
+ ERROR_NOLOGON_SERVER_TRUST_ACCOUNT
+ ERROR_NOLOGON_WORKSTATION_TRUST_ACCOUNT
+ ERROR_NONE_MAPPED
+ ERROR_NON_MDICHILD_WINDOW
+ ERROR_NOTIFY_ENUM_DIR
+ ERROR_NOT_ALL_ASSIGNED
+ ERROR_NOT_CHILD_WINDOW
+ ERROR_NOT_CONNECTED
+ ERROR_NOT_CONTAINER
+ ERROR_NOT_DOS_DISK
+ ERROR_NOT_ENOUGH_MEMORY
+ ERROR_NOT_ENOUGH_QUOTA
+ ERROR_NOT_ENOUGH_SERVER_MEMORY
+ ERROR_NOT_JOINED
+ ERROR_NOT_LOCKED
+ ERROR_NOT_LOGON_PROCESS
+ ERROR_NOT_OWNER
+ ERROR_NOT_READY
+ ERROR_NOT_REGISTRY_FILE
+ ERROR_NOT_SAME_DEVICE
+ ERROR_NOT_SUBSTED
+ ERROR_NOT_SUPPORTED
+ ERROR_NO_BROWSER_SERVERS_FOUND
+ ERROR_NO_DATA
+ ERROR_NO_DATA_DETECTED
+ ERROR_NO_IMPERSONATION_TOKEN
+ ERROR_NO_INHERITANCE
+ ERROR_NO_LOGON_SERVERS
+ ERROR_NO_LOG_SPACE
+ ERROR_NO_MEDIA_IN_DRIVE
+ ERROR_NO_MORE_FILES
+ ERROR_NO_MORE_ITEMS
+ ERROR_NO_MORE_SEARCH_HANDLES
+ ERROR_NO_NETWORK
+ ERROR_NO_NET_OR_BAD_PATH
+ ERROR_NO_PROC_SLOTS
+ ERROR_NO_QUOTAS_FOR_ACCOUNT
+ ERROR_NO_SCROLLBARS
+ ERROR_NO_SECURITY_ON_OBJECT
+ ERROR_NO_SHUTDOWN_IN_PROGRESS
+ ERROR_NO_SIGNAL_SENT
+ ERROR_NO_SPOOL_SPACE
+ ERROR_NO_SUCH_ALIAS
+ ERROR_NO_SUCH_DOMAIN
+ ERROR_NO_SUCH_GROUP
+ ERROR_NO_SUCH_LOGON_SESSION
+ ERROR_NO_SUCH_MEMBER
+ ERROR_NO_SUCH_PACKAGE
+ ERROR_NO_SUCH_PRIVILEGE
+ ERROR_NO_SUCH_USER
+ ERROR_NO_SYSTEM_MENU
+ ERROR_NO_TOKEN
+ ERROR_NO_TRUST_LSA_SECRET
+ ERROR_NO_TRUST_SAM_ACCOUNT
+ ERROR_NO_UNICODE_TRANSLATION
+ ERROR_NO_USER_SESSION_KEY
+ ERROR_NO_VOLUME_LABEL
+ ERROR_NO_WILDCARD_CHARACTERS
+ ERROR_NT_CROSS_ENCRYPTION_REQUIRED
+ ERROR_NULL_LM_PASSWORD
+ ERROR_OPEN_FAILED
+ ERROR_OPEN_FILES
+ ERROR_OPERATION_ABORTED
+ ERROR_OUTOFMEMORY
+ ERROR_OUT_OF_PAPER
+ ERROR_OUT_OF_STRUCTURES
+ ERROR_PARTIAL_COPY
+ ERROR_PARTITION_FAILURE
+ ERROR_PASSWORD_EXPIRED
+ ERROR_PASSWORD_MUST_CHANGE
+ ERROR_PASSWORD_RESTRICTION
+ ERROR_PATH_BUSY
+ ERROR_PATH_NOT_FOUND
+ ERROR_PIPE_BUSY
+ ERROR_PIPE_CONNECTED
+ ERROR_PIPE_LISTENING
+ ERROR_PIPE_NOT_CONNECTED
+ ERROR_POPUP_ALREADY_ACTIVE
+ ERROR_PORT_UNREACHABLE
+ ERROR_POSSIBLE_DEADLOCK
+ ERROR_PRINTER_ALREADY_EXISTS
+ ERROR_PRINTER_DELETED
+ ERROR_PRINTER_DRIVER_ALREADY_INSTALLED
+ ERROR_PRINTER_DRIVER_IN_USE
+ ERROR_PRINTQ_FULL
+ ERROR_PRINT_CANCELLED
+ ERROR_PRINT_MONITOR_ALREADY_INSTALLED
+ ERROR_PRINT_PROCESSOR_ALREADY_INSTALLED
+ ERROR_PRIVATE_DIALOG_INDEX
+ ERROR_PRIVILEGE_NOT_HELD
+ ERROR_PROCESS_ABORTED
+ ERROR_PROC_NOT_FOUND
+ ERROR_PROTOCOL_UNREACHABLE
+ ERROR_READ_FAULT
+ ERROR_REC_NON_EXISTENT
+ ERROR_REDIRECTOR_HAS_OPEN_HANDLES
+ ERROR_REDIR_PAUSED
+ ERROR_REGISTRY_CORRUPT
+ ERROR_REGISTRY_IO_FAILED
+ ERROR_REGISTRY_RECOVERED
+ ERROR_RELOC_CHAIN_XEEDS_SEGLIM
+ ERROR_REMOTE_SESSION_LIMIT_EXCEEDED
+ ERROR_REM_NOT_LIST
+ ERROR_REQUEST_ABORTED
+ ERROR_REQ_NOT_ACCEP
+ ERROR_RESOURCE_DATA_NOT_FOUND
+ ERROR_RESOURCE_LANG_NOT_FOUND
+ ERROR_RESOURCE_NAME_NOT_FOUND
+ ERROR_RESOURCE_TYPE_NOT_FOUND
+ ERROR_RETRY
+ ERROR_REVISION_MISMATCH
+ ERROR_RING2SEG_MUST_BE_MOVABLE
+ ERROR_RING2_STACK_IN_USE
+ ERROR_RPL_NOT_ALLOWED
+ ERROR_RXACT_COMMIT_FAILURE
+ ERROR_RXACT_INVALID_STATE
+ ERROR_SAME_DRIVE
+ ERROR_SCREEN_ALREADY_LOCKED
+ ERROR_SECRET_TOO_LONG
+ ERROR_SECTOR_NOT_FOUND
+ ERROR_SEEK
+ ERROR_SEEK_ON_DEVICE
+ ERROR_SEM_IS_SET
+ ERROR_SEM_NOT_FOUND
+ ERROR_SEM_OWNER_DIED
+ ERROR_SEM_TIMEOUT
+ ERROR_SEM_USER_LIMIT
+ ERROR_SERIAL_NO_DEVICE
+ ERROR_SERVER_DISABLED
+ ERROR_SERVER_HAS_OPEN_HANDLES
+ ERROR_SERVER_NOT_DISABLED
+ ERROR_SERVICE_ALREADY_RUNNING
+ ERROR_SERVICE_CANNOT_ACCEPT_CTRL
+ ERROR_SERVICE_DATABASE_LOCKED
+ ERROR_SERVICE_DEPENDENCY_DELETED
+ ERROR_SERVICE_DEPENDENCY_FAIL
+ ERROR_SERVICE_DISABLED
+ ERROR_SERVICE_DOES_NOT_EXIST
+ ERROR_SERVICE_EXISTS
+ ERROR_SERVICE_LOGON_FAILED
+ ERROR_SERVICE_MARKED_FOR_DELETE
+ ERROR_SERVICE_NEVER_STARTED
+ ERROR_SERVICE_NOT_ACTIVE
+ ERROR_SERVICE_NOT_FOUND
+ ERROR_SERVICE_NO_THREAD
+ ERROR_SERVICE_REQUEST_TIMEOUT
+ ERROR_SERVICE_SPECIFIC_ERROR
+ ERROR_SERVICE_START_HANG
+ ERROR_SESSION_CREDENTIAL_CONFLICT
+ ERROR_SETCOUNT_ON_BAD_LB
+ ERROR_SETMARK_DETECTED
+ ERROR_SHARING_BUFFER_EXCEEDED
+ ERROR_SHARING_PAUSED
+ ERROR_SHARING_VIOLATION
+ ERROR_SHUTDOWN_IN_PROGRESS
+ ERROR_SIGNAL_PENDING
+ ERROR_SIGNAL_REFUSED
+ ERROR_SOME_NOT_MAPPED
+ ERROR_SPECIAL_ACCOUNT
+ ERROR_SPECIAL_GROUP
+ ERROR_SPECIAL_USER
+ ERROR_SPL_NO_ADDJOB
+ ERROR_SPL_NO_STARTDOC
+ ERROR_SPOOL_FILE_NOT_FOUND
+ ERROR_STACK_OVERFLOW
+ ERROR_STATIC_INIT
+ ERROR_SUBST_TO_JOIN
+ ERROR_SUBST_TO_SUBST
+ ERROR_SUCCESS
+ ERROR_SWAPERROR
+ ERROR_SYSTEM_TRACE
+ ERROR_THREAD_1_INACTIVE
+ ERROR_TLW_WITH_WSCHILD
+ ERROR_TOKEN_ALREADY_IN_USE
+ ERROR_TOO_MANY_CMDS
+ ERROR_TOO_MANY_CONTEXT_IDS
+ ERROR_TOO_MANY_LUIDS_REQUESTED
+ ERROR_TOO_MANY_MODULES
+ ERROR_TOO_MANY_MUXWAITERS
+ ERROR_TOO_MANY_NAMES
+ ERROR_TOO_MANY_OPEN_FILES
+ ERROR_TOO_MANY_POSTS
+ ERROR_TOO_MANY_SECRETS
+ ERROR_TOO_MANY_SEMAPHORES
+ ERROR_TOO_MANY_SEM_REQUESTS
+ ERROR_TOO_MANY_SESS
+ ERROR_TOO_MANY_SIDS
+ ERROR_TOO_MANY_TCBS
+ ERROR_TRANSFORM_NOT_SUPPORTED
+ ERROR_TRUSTED_DOMAIN_FAILURE
+ ERROR_TRUSTED_RELATIONSHIP_FAILURE
+ ERROR_TRUST_FAILURE
+ ERROR_UNABLE_TO_LOCK_MEDIA
+ ERROR_UNABLE_TO_UNLOAD_MEDIA
+ ERROR_UNEXP_NET_ERR
+ ERROR_UNKNOWN_PORT
+ ERROR_UNKNOWN_PRINTER_DRIVER
+ ERROR_UNKNOWN_PRINTPROCESSOR
+ ERROR_UNKNOWN_PRINT_MONITOR
+ ERROR_UNKNOWN_REVISION
+ ERROR_UNRECOGNIZED_MEDIA
+ ERROR_UNRECOGNIZED_VOLUME
+ ERROR_USER_EXISTS
+ ERROR_USER_MAPPED_FILE
+ ERROR_VC_DISCONNECTED
+ ERROR_WAIT_NO_CHILDREN
+ ERROR_WINDOW_NOT_COMBOBOX
+ ERROR_WINDOW_NOT_DIALOG
+ ERROR_WINDOW_OF_OTHER_THREAD
+ ERROR_WINS_INTERNAL
+ ERROR_WRITE_FAULT
+ ERROR_WRITE_PROTECT
+ ERROR_WRONG_DISK
+ ERROR_WRONG_PASSWORD
+ E_ABORT
+ E_ACCESSDENIED
+ E_FAIL
+ E_HANDLE
+ E_INVALIDARG
+ E_NOINTERFACE
+ E_NOTIMPL
+ E_OUTOFMEMORY
+ E_POINTER
+ E_UNEXPECTED
+ FACILITY_CONTROL
+ FACILITY_DISPATCH
+ FACILITY_ITF
+ FACILITY_NT_BIT
+ FACILITY_NULL
+ FACILITY_RPC
+ FACILITY_STORAGE
+ FACILITY_WIN32
+ FACILITY_WINDOWS
+ INPLACE_E_FIRST
+ INPLACE_E_LAST
+ INPLACE_E_NOTOOLSPACE
+ INPLACE_E_NOTUNDOABLE
+ INPLACE_S_FIRST
+ INPLACE_S_LAST
+ INPLACE_S_TRUNCATED
+ MARSHAL_E_FIRST
+ MARSHAL_E_LAST
+ MARSHAL_S_FIRST
+ MARSHAL_S_LAST
+ MEM_E_INVALID_LINK
+ MEM_E_INVALID_ROOT
+ MEM_E_INVALID_SIZE
+ MK_E_CANTOPENFILE
+ MK_E_CONNECTMANUALLY
+ MK_E_ENUMERATION_FAILED
+ MK_E_EXCEEDEDDEADLINE
+ MK_E_FIRST
+ MK_E_INTERMEDIATEINTERFACENOTSUPPORTED
+ MK_E_INVALIDEXTENSION
+ MK_E_LAST
+ MK_E_MUSTBOTHERUSER
+ MK_E_NEEDGENERIC
+ MK_E_NOINVERSE
+ MK_E_NOOBJECT
+ MK_E_NOPREFIX
+ MK_E_NOSTORAGE
+ MK_E_NOTBINDABLE
+ MK_E_NOTBOUND
+ MK_E_NO_NORMALIZED
+ MK_E_SYNTAX
+ MK_E_UNAVAILABLE
+ MK_S_FIRST
+ MK_S_HIM
+ MK_S_LAST
+ MK_S_ME
+ MK_S_MONIKERALREADYREGISTERED
+ MK_S_REDUCED_TO_SELF
+ MK_S_US
+ NOERROR
+ NO_ERROR
+ OLEOBJ_E_FIRST
+ OLEOBJ_E_INVALIDVERB
+ OLEOBJ_E_LAST
+ OLEOBJ_E_NOVERBS
+ OLEOBJ_S_CANNOT_DOVERB_NOW
+ OLEOBJ_S_FIRST
+ OLEOBJ_S_INVALIDHWND
+ OLEOBJ_S_INVALIDVERB
+ OLEOBJ_S_LAST
+ OLE_E_ADVF
+ OLE_E_ADVISENOTSUPPORTED
+ OLE_E_BLANK
+ OLE_E_CANTCONVERT
+ OLE_E_CANT_BINDTOSOURCE
+ OLE_E_CANT_GETMONIKER
+ OLE_E_CLASSDIFF
+ OLE_E_ENUM_NOMORE
+ OLE_E_FIRST
+ OLE_E_INVALIDHWND
+ OLE_E_INVALIDRECT
+ OLE_E_LAST
+ OLE_E_NOCACHE
+ OLE_E_NOCONNECTION
+ OLE_E_NOSTORAGE
+ OLE_E_NOTRUNNING
+ OLE_E_NOT_INPLACEACTIVE
+ OLE_E_OLEVERB
+ OLE_E_PROMPTSAVECANCELLED
+ OLE_E_STATIC
+ OLE_E_WRONGCOMPOBJ
+ OLE_S_FIRST
+ OLE_S_LAST
+ OLE_S_MAC_CLIPFORMAT
+ OLE_S_STATIC
+ OLE_S_USEREG
+ REGDB_E_CLASSNOTREG
+ REGDB_E_FIRST
+ REGDB_E_IIDNOTREG
+ REGDB_E_INVALIDVALUE
+ REGDB_E_KEYMISSING
+ REGDB_E_LAST
+ REGDB_E_READREGDB
+ REGDB_E_WRITEREGDB
+ REGDB_S_FIRST
+ REGDB_S_LAST
+ RPC_E_ATTEMPTED_MULTITHREAD
+ RPC_E_CALL_CANCELED
+ RPC_E_CALL_REJECTED
+ RPC_E_CANTCALLOUT_AGAIN
+ RPC_E_CANTCALLOUT_INASYNCCALL
+ RPC_E_CANTCALLOUT_INEXTERNALCALL
+ RPC_E_CANTCALLOUT_ININPUTSYNCCALL
+ RPC_E_CANTPOST_INSENDCALL
+ RPC_E_CANTTRANSMIT_CALL
+ RPC_E_CHANGED_MODE
+ RPC_E_CLIENT_CANTMARSHAL_DATA
+ RPC_E_CLIENT_CANTUNMARSHAL_DATA
+ RPC_E_CLIENT_DIED
+ RPC_E_CONNECTION_TERMINATED
+ RPC_E_DISCONNECTED
+ RPC_E_FAULT
+ RPC_E_INVALIDMETHOD
+ RPC_E_INVALID_CALLDATA
+ RPC_E_INVALID_DATA
+ RPC_E_INVALID_DATAPACKET
+ RPC_E_INVALID_PARAMETER
+ RPC_E_NOT_REGISTERED
+ RPC_E_OUT_OF_RESOURCES
+ RPC_E_RETRY
+ RPC_E_SERVERCALL_REJECTED
+ RPC_E_SERVERCALL_RETRYLATER
+ RPC_E_SERVERFAULT
+ RPC_E_SERVER_CANTMARSHAL_DATA
+ RPC_E_SERVER_CANTUNMARSHAL_DATA
+ RPC_E_SERVER_DIED
+ RPC_E_SERVER_DIED_DNE
+ RPC_E_SYS_CALL_FAILED
+ RPC_E_THREAD_NOT_INIT
+ RPC_E_UNEXPECTED
+ RPC_E_WRONG_THREAD
+ RPC_S_ADDRESS_ERROR
+ RPC_S_ALREADY_LISTENING
+ RPC_S_ALREADY_REGISTERED
+ RPC_S_BINDING_HAS_NO_AUTH
+ RPC_S_BINDING_INCOMPLETE
+ RPC_S_CALL_CANCELLED
+ RPC_S_CALL_FAILED
+ RPC_S_CALL_FAILED_DNE
+ RPC_S_CALL_IN_PROGRESS
+ RPC_S_CANNOT_SUPPORT
+ RPC_S_CANT_CREATE_ENDPOINT
+ RPC_S_COMM_FAILURE
+ RPC_S_DUPLICATE_ENDPOINT
+ RPC_S_ENTRY_ALREADY_EXISTS
+ RPC_S_ENTRY_NOT_FOUND
+ RPC_S_FP_DIV_ZERO
+ RPC_S_FP_OVERFLOW
+ RPC_S_FP_UNDERFLOW
+ RPC_S_GROUP_MEMBER_NOT_FOUND
+ RPC_S_INCOMPLETE_NAME
+ RPC_S_INTERFACE_NOT_FOUND
+ RPC_S_INTERNAL_ERROR
+ RPC_S_INVALID_AUTH_IDENTITY
+ RPC_S_INVALID_BINDING
+ RPC_S_INVALID_BOUND
+ RPC_S_INVALID_ENDPOINT_FORMAT
+ RPC_S_INVALID_NAF_ID
+ RPC_S_INVALID_NAME_SYNTAX
+ RPC_S_INVALID_NETWORK_OPTIONS
+ RPC_S_INVALID_NET_ADDR
+ RPC_S_INVALID_OBJECT
+ RPC_S_INVALID_RPC_PROTSEQ
+ RPC_S_INVALID_STRING_BINDING
+ RPC_S_INVALID_STRING_UUID
+ RPC_S_INVALID_TAG
+ RPC_S_INVALID_TIMEOUT
+ RPC_S_INVALID_VERS_OPTION
+ RPC_S_MAX_CALLS_TOO_SMALL
+ RPC_S_NAME_SERVICE_UNAVAILABLE
+ RPC_S_NOTHING_TO_EXPORT
+ RPC_S_NOT_ALL_OBJS_UNEXPORTED
+ RPC_S_NOT_CANCELLED
+ RPC_S_NOT_LISTENING
+ RPC_S_NOT_RPC_ERROR
+ RPC_S_NO_BINDINGS
+ RPC_S_NO_CALL_ACTIVE
+ RPC_S_NO_CONTEXT_AVAILABLE
+ RPC_S_NO_ENDPOINT_FOUND
+ RPC_S_NO_ENTRY_NAME
+ RPC_S_NO_INTERFACES
+ RPC_S_NO_MORE_BINDINGS
+ RPC_S_NO_MORE_MEMBERS
+ RPC_S_NO_PRINC_NAME
+ RPC_S_NO_PROTSEQS
+ RPC_S_NO_PROTSEQS_REGISTERED
+ RPC_S_OBJECT_NOT_FOUND
+ RPC_S_OUT_OF_RESOURCES
+ RPC_S_PROCNUM_OUT_OF_RANGE
+ RPC_S_PROTOCOL_ERROR
+ RPC_S_PROTSEQ_NOT_FOUND
+ RPC_S_PROTSEQ_NOT_SUPPORTED
+ RPC_S_SEC_PKG_ERROR
+ RPC_S_SERVER_TOO_BUSY
+ RPC_S_SERVER_UNAVAILABLE
+ RPC_S_STRING_TOO_LONG
+ RPC_S_TYPE_ALREADY_REGISTERED
+ RPC_S_UNKNOWN_AUTHN_LEVEL
+ RPC_S_UNKNOWN_AUTHN_SERVICE
+ RPC_S_UNKNOWN_AUTHN_TYPE
+ RPC_S_UNKNOWN_AUTHZ_SERVICE
+ RPC_S_UNKNOWN_IF
+ RPC_S_UNKNOWN_MGR_TYPE
+ RPC_S_UNSUPPORTED_AUTHN_LEVEL
+ RPC_S_UNSUPPORTED_NAME_SYNTAX
+ RPC_S_UNSUPPORTED_TRANS_SYN
+ RPC_S_UNSUPPORTED_TYPE
+ RPC_S_UUID_LOCAL_ONLY
+ RPC_S_UUID_NO_ADDRESS
+ RPC_S_WRONG_KIND_OF_BINDING
+ RPC_S_ZERO_DIVIDE
+ RPC_X_BAD_STUB_DATA
+ RPC_X_BYTE_COUNT_TOO_SMALL
+ RPC_X_ENUM_VALUE_OUT_OF_RANGE
+ RPC_X_INVALID_ES_ACTION
+ RPC_X_NO_MORE_ENTRIES
+ RPC_X_NULL_REF_POINTER
+ RPC_X_SS_CANNOT_GET_CALL_HANDLE
+ RPC_X_SS_CHAR_TRANS_OPEN_FAIL
+ RPC_X_SS_CHAR_TRANS_SHORT_FILE
+ RPC_X_SS_CONTEXT_DAMAGED
+ RPC_X_SS_HANDLES_MISMATCH
+ RPC_X_SS_IN_NULL_CONTEXT
+ RPC_X_WRONG_ES_VERSION
+ RPC_X_WRONG_STUB_VERSION
+ SEVERITY_ERROR
+ SEVERITY_SUCCESS
+ STG_E_ABNORMALAPIEXIT
+ STG_E_ACCESSDENIED
+ STG_E_CANTSAVE
+ STG_E_DISKISWRITEPROTECTED
+ STG_E_EXTANTMARSHALLINGS
+ STG_E_FILEALREADYEXISTS
+ STG_E_FILENOTFOUND
+ STG_E_INSUFFICIENTMEMORY
+ STG_E_INUSE
+ STG_E_INVALIDFLAG
+ STG_E_INVALIDFUNCTION
+ STG_E_INVALIDHANDLE
+ STG_E_INVALIDHEADER
+ STG_E_INVALIDNAME
+ STG_E_INVALIDPARAMETER
+ STG_E_INVALIDPOINTER
+ STG_E_LOCKVIOLATION
+ STG_E_MEDIUMFULL
+ STG_E_NOMOREFILES
+ STG_E_NOTCURRENT
+ STG_E_NOTFILEBASEDSTORAGE
+ STG_E_OLDDLL
+ STG_E_OLDFORMAT
+ STG_E_PATHNOTFOUND
+ STG_E_READFAULT
+ STG_E_REVERTED
+ STG_E_SEEKERROR
+ STG_E_SHAREREQUIRED
+ STG_E_SHAREVIOLATION
+ STG_E_TOOMANYOPENFILES
+ STG_E_UNIMPLEMENTEDFUNCTION
+ STG_E_UNKNOWN
+ STG_E_WRITEFAULT
+ STG_S_CONVERTED
+ S_FALSE
+ S_OK
+ TYPE_E_AMBIGUOUSNAME
+ TYPE_E_BADMODULEKIND
+ TYPE_E_BUFFERTOOSMALL
+ TYPE_E_CANTCREATETMPFILE
+ TYPE_E_CANTLOADLIBRARY
+ TYPE_E_CIRCULARTYPE
+ TYPE_E_DLLFUNCTIONNOTFOUND
+ TYPE_E_DUPLICATEID
+ TYPE_E_ELEMENTNOTFOUND
+ TYPE_E_INCONSISTENTPROPFUNCS
+ TYPE_E_INVALIDID
+ TYPE_E_INVALIDSTATE
+ TYPE_E_INVDATAREAD
+ TYPE_E_IOERROR
+ TYPE_E_LIBNOTREGISTERED
+ TYPE_E_NAMECONFLICT
+ TYPE_E_OUTOFBOUNDS
+ TYPE_E_QUALIFIEDNAMEDISALLOWED
+ TYPE_E_REGISTRYACCESS
+ TYPE_E_SIZETOOBIG
+ TYPE_E_TYPEMISMATCH
+ TYPE_E_UNDEFINEDTYPE
+ TYPE_E_UNKNOWNLCID
+ TYPE_E_UNSUPFORMAT
+ TYPE_E_WRONGTYPEKIND
+ VIEW_E_DRAW
+ VIEW_E_FIRST
+ VIEW_E_LAST
+ VIEW_S_ALREADY_FROZEN
+ VIEW_S_FIRST
+ VIEW_S_LAST
+);
+
+sub AUTOLOAD {
+ # This AUTOLOAD is used to 'autoload' constants from the constant()
+ # XS function. If a constant is not found then control is passed
+ # to the AUTOLOAD in AutoLoader.
+
+ my($constname);
+ ($constname = $AUTOLOAD) =~ s/.*:://;
+ #reset $! to zero to reset any current errors.
+ local $! = 0;
+ local $^E = 0;
+ my $val = constant($constname, @_ ? $_[0] : 0);
+ if ($! != 0) {
+ if ($! =~ /Invalid/) {
+ $AutoLoader::AUTOLOAD = $AUTOLOAD;
+ goto &AutoLoader::AUTOLOAD;
+ }
+ else {
+ ($pack,$file,$line) = caller;
+ die "Your vendor has not defined Win32::WinError macro $constname, used at $file line $line.";
+ }
+ }
+ eval "sub $AUTOLOAD { $val }";
+ goto &$AUTOLOAD;
+}
+
+bootstrap Win32::WinError;
+
+# Preloaded methods go here.
+
+# Autoload methods go after __END__, and are processed by the autosplit program.
+
+1;
+__END__
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32API/Registry.pm b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32API/Registry.pm
new file mode 100644
index 0000000000..1004ea1b09
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32API/Registry.pm
@@ -0,0 +1,1779 @@
+# Registry.pm -- Low-level access to functions/constants from WINREG.h
+
+package Win32API::Registry;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); #@EXPORT_FAIL);
+$VERSION= '0.33';
+
+require Exporter;
+require DynaLoader;
+@ISA= qw(Exporter DynaLoader);
+
+@EXPORT= qw();
+%EXPORT_TAGS= (
+ Func => [qw( regConstant regLastError
+ AllowPriv AbortSystemShutdown InitiateSystemShutdown
+ RegCloseKey RegConnectRegistry RegCreateKey
+ RegCreateKeyEx RegDeleteKey RegDeleteValue
+ RegEnumKey RegEnumKeyEx RegEnumValue
+ RegFlushKey RegGetKeySecurity RegLoadKey
+ RegNotifyChangeKeyValue RegOpenKey RegOpenKeyEx
+ RegQueryInfoKey RegQueryMultipleValues RegQueryValue
+ RegQueryValueEx RegReplaceKey RegRestoreKey
+ RegSaveKey RegSetKeySecurity RegSetValue
+ RegSetValueEx RegUnLoadKey )],
+ FuncA => [qw(
+ AbortSystemShutdownA InitiateSystemShutdownA
+ RegConnectRegistryA RegCreateKeyA RegCreateKeyExA
+ RegDeleteKeyA RegDeleteValueA RegEnumKeyA
+ RegEnumKeyExA RegEnumValueA RegLoadKeyA
+ RegOpenKeyA RegOpenKeyExA RegQueryInfoKeyA
+ RegQueryMultipleValuesA RegQueryValueA RegQueryValueExA
+ RegReplaceKeyA RegRestoreKeyA RegSaveKeyA
+ RegSetValueA RegSetValueExA RegUnLoadKeyA )],
+ FuncW => [qw(
+ AbortSystemShutdownW InitiateSystemShutdownW
+ RegConnectRegistryW RegCreateKeyW RegCreateKeyExW
+ RegDeleteKeyW RegDeleteValueW RegEnumKeyW
+ RegEnumKeyExW RegEnumValueW RegLoadKeyW
+ RegOpenKeyW RegOpenKeyExW RegQueryInfoKeyW
+ RegQueryMultipleValuesW RegQueryValueW RegQueryValueExW
+ RegReplaceKeyW RegRestoreKeyW RegSaveKeyW
+ RegSetValueW RegSetValueExW RegUnLoadKeyW )],
+ HKEY_ => [qw(
+ HKEY_CLASSES_ROOT HKEY_CURRENT_CONFIG HKEY_CURRENT_USER
+ HKEY_DYN_DATA HKEY_LOCAL_MACHINE HKEY_PERFORMANCE_DATA
+ HKEY_USERS )],
+ KEY_ => [qw(
+ KEY_QUERY_VALUE KEY_SET_VALUE KEY_CREATE_SUB_KEY
+ KEY_ENUMERATE_SUB_KEYS KEY_NOTIFY KEY_CREATE_LINK
+ KEY_READ KEY_WRITE KEY_EXECUTE
+ KEY_ALL_ACCESS),
+ 'KEY_DELETE', # DELETE (0x00010000L)
+ 'KEY_READ_CONTROL', # READ_CONTROL (0x00020000L)
+ 'KEY_WRITE_DAC', # WRITE_DAC (0x00040000L)
+ 'KEY_WRITE_OWNER', # WRITE_OWNER (0x00080000L)
+ 'KEY_SYNCHRONIZE', # SYNCHRONIZE (0x00100000L) (not used)
+ ],
+ REG_ => [qw(
+ REG_OPTION_RESERVED REG_OPTION_NON_VOLATILE REG_OPTION_VOLATILE
+ REG_OPTION_CREATE_LINK REG_OPTION_BACKUP_RESTORE
+ REG_OPTION_OPEN_LINK REG_LEGAL_OPTION REG_CREATED_NEW_KEY
+ REG_OPENED_EXISTING_KEY REG_WHOLE_HIVE_VOLATILE REG_REFRESH_HIVE
+ REG_NO_LAZY_FLUSH REG_NOTIFY_CHANGE_ATTRIBUTES
+ REG_NOTIFY_CHANGE_NAME REG_NOTIFY_CHANGE_LAST_SET
+ REG_NOTIFY_CHANGE_SECURITY REG_LEGAL_CHANGE_FILTER
+ REG_NONE REG_SZ REG_EXPAND_SZ
+ REG_BINARY REG_DWORD REG_DWORD_LITTLE_ENDIAN
+ REG_DWORD_BIG_ENDIAN REG_LINK REG_MULTI_SZ
+ REG_RESOURCE_LIST REG_FULL_RESOURCE_DESCRIPTOR
+ REG_RESOURCE_REQUIREMENTS_LIST )],
+ SE_ => [qw(
+ SE_ASSIGNPRIMARYTOKEN_NAME SE_AUDIT_NAME
+ SE_BACKUP_NAME SE_CHANGE_NOTIFY_NAME
+ SE_CREATE_PAGEFILE_NAME SE_CREATE_PERMANENT_NAME
+ SE_CREATE_TOKEN_NAME SE_DEBUG_NAME
+ SE_INCREASE_QUOTA_NAME SE_INC_BASE_PRIORITY_NAME
+ SE_LOAD_DRIVER_NAME SE_LOCK_MEMORY_NAME
+ SE_MACHINE_ACCOUNT_NAME SE_PROF_SINGLE_PROCESS_NAME
+ SE_REMOTE_SHUTDOWN_NAME SE_RESTORE_NAME
+ SE_SECURITY_NAME SE_SHUTDOWN_NAME
+ SE_SYSTEMTIME_NAME SE_SYSTEM_ENVIRONMENT_NAME
+ SE_SYSTEM_PROFILE_NAME SE_TAKE_OWNERSHIP_NAME
+ SE_TCB_NAME SE_UNSOLICITED_INPUT_NAME )],
+);
+@EXPORT_OK= ();
+{ my $ref;
+ foreach $ref ( values(%EXPORT_TAGS) ) {
+ push( @EXPORT_OK, @$ref ) unless $ref->[0] =~ /^SE_/;
+ }
+}
+$EXPORT_TAGS{ALL}= [ @EXPORT_OK ]; # \@EXPORT_OK once SE_* settles down.
+# push( @EXPORT_OK, "JHEREG_TACOSALAD" ); # Used to test Mkconst2perl
+push( @EXPORT_OK, @{$EXPORT_TAGS{SE_}} );
+
+bootstrap Win32API::Registry $VERSION;
+
+# Preloaded methods go here.
+
+# To convert C constants to Perl code in cRegistry.pc
+# [instead of C or C++ code in cRegistry.h]:
+# * Modify F<Makefile.PL> to add WriteMakeFile() =>
+# CONST2PERL/postamble => [[ "Win32API::Registry" => ]] WRITE_PERL => 1.
+# * Either comment out C<#include "cRegistry.h"> from F<Registry.xs>
+# or make F<cRegistry.h> an empty file.
+# * Make sure the following C<if> block is not commented out.
+# * "nmake clean", "perl Makefile.PL", "nmake"
+
+if( ! defined &REG_NONE ) {
+ require "Win32API/Registry/cRegistry.pc";
+}
+
+# This would be convenient but inconsistent and hard to explain:
+#push( @{$EXPORT_TAGS{ALL}}, @{$EXPORT_TAGS{SE_}} )
+# if defined &SE_TCB_NAME;
+
+sub regConstant
+{
+ my( $name )= @_;
+ if( 1 != @_ || ! $name || $name =~ /\W/ ) {
+ require Carp;
+ Carp::croak( 'Usage: ',__PACKAGE__,'::regConstant("CONST_NAME")' );
+ }
+ my $proto= prototype $name;
+ if( defined \&$name
+ && defined $proto
+ && "" eq $proto ) {
+ no strict 'refs';
+ return &$name;
+ }
+ return undef;
+}
+
+# We provide this for backwards compatibility:
+sub constant
+{
+ my( $name )= @_;
+ my $value= regConstant( $name );
+ if( defined $value ) {
+ $!= 0;
+ return $value;
+ }
+ $!= 11; # EINVAL
+ return 0;
+}
+
+BEGIN {
+ my $code= 'return _regLastError(@_)';
+ local( $!, $^E )= ( 1, 1 );
+ if( $! ne $^E ) {
+ $code= '
+ local( $^E )= _regLastError(@_);
+ my $ret= $^E;
+ return $ret;
+ ';
+ }
+ eval "sub regLastError { $code }";
+ die "$@" if $@;
+}
+
+# Since we ISA DynaLoader which ISA AutoLoader, we ISA AutoLoader so we
+# need this next chunk to prevent Win32API::Registry->nonesuch() from
+# looking for "nonesuch.al" and producing confusing error messages:
+use vars qw($AUTOLOAD);
+sub AUTOLOAD {
+ require Carp;
+ Carp::croak(
+ "Can't locate method $AUTOLOAD via package Win32API::Registry" );
+}
+
+# Replace "&rout;" with "goto &rout;" when that is supported on Win32.
+
+# Let user omit all buffer sizes:
+sub RegEnumKeyExA {
+ if( 6 == @_ ) { splice(@_,4,0,[]); splice(@_,2,0,[]); }
+ &_RegEnumKeyExA;
+}
+sub RegEnumKeyExW {
+ if( 6 == @_ ) { splice(@_,4,0,[]); splice(@_,2,0,[]); }
+ &_RegEnumKeyExW;
+}
+sub RegEnumValueA {
+ if( 6 == @_ ) { splice(@_,2,0,[]); push(@_,[]); }
+ &_RegEnumValueA;
+}
+sub RegEnumValueW {
+ if( 6 == @_ ) { splice(@_,2,0,[]); push(@_,[]); }
+ &_RegEnumValueW;
+}
+sub RegQueryInfoKeyA {
+ if( 11 == @_ ) { splice(@_,2,0,[]); }
+ &_RegQueryInfoKeyA;
+}
+sub RegQueryInfoKeyW {
+ if( 11 == @_ ) { splice(@_,2,0,[]); }
+ &_RegQueryInfoKeyW;
+}
+
+sub RegEnumKeyA {
+ push(@_,[]) if 3 == @_;
+ &_RegEnumKeyA;
+}
+sub RegEnumKeyW {
+ push(@_,[]) if 3 == @_;
+ &_RegEnumKeyW;
+}
+sub RegGetKeySecurity {
+ push(@_,[]) if 3 == @_;
+ &_RegGetKeySecurity;
+}
+sub RegQueryMultipleValuesA {
+ push(@_,[]) if 4 == @_;
+ &_RegQueryMultipleValuesA;
+}
+sub RegQueryMultipleValuesW {
+ push(@_,[]) if 4 == @_;
+ &_RegQueryMultipleValuesW;
+}
+sub RegQueryValueA {
+ push(@_,[]) if 3 == @_;
+ &_RegQueryValueA;
+}
+sub RegQueryValueW {
+ push(@_,[]) if 3 == @_;
+ &_RegQueryValueW;
+}
+sub RegQueryValueExA {
+ push(@_,[]) if 5 == @_;
+ &_RegQueryValueExA;
+}
+sub RegQueryValueExW {
+ push(@_,[]) if 5 == @_;
+ &_RegQueryValueExW;
+}
+sub RegSetValueA {
+ push(@_,0) if 4 == @_;
+ &_RegSetValueA;
+}
+sub RegSetValueW {
+ push(@_,0) if 4 == @_;
+ &_RegSetValueW;
+}
+sub RegSetValueExA {
+ push(@_,0) if 5 == @_;
+ &_RegSetValueExA;
+}
+sub RegSetValueExW {
+ push(@_,0) if 5 == @_;
+ &_RegSetValueExW;
+}
+
+# Aliases for non-Unicode functions:
+sub AbortSystemShutdown { &AbortSystemShutdownA; }
+sub InitiateSystemShutdown { &InitiateSystemShutdownA; }
+sub RegConnectRegistry { &RegConnectRegistryA; }
+sub RegCreateKey { &RegCreateKeyA; }
+sub RegCreateKeyEx { &RegCreateKeyExA; }
+sub RegDeleteKey { &RegDeleteKeyA; }
+sub RegDeleteValue { &RegDeleteValueA; }
+sub RegEnumKey { &RegEnumKeyA; }
+sub RegEnumKeyEx { &RegEnumKeyExA; }
+sub RegEnumValue { &RegEnumValueA; }
+sub RegLoadKey { &RegLoadKeyA; }
+sub RegOpenKey { &RegOpenKeyA; }
+sub RegOpenKeyEx { &RegOpenKeyExA; }
+sub RegQueryInfoKey { &RegQueryInfoKeyA; }
+sub RegQueryMultipleValues { &RegQueryMultipleValuesA; }
+sub RegQueryValue { &RegQueryValueA; }
+sub RegQueryValueEx { &RegQueryValueExA; }
+sub RegReplaceKey { &RegReplaceKeyA; }
+sub RegRestoreKey { &RegRestoreKeyA; }
+sub RegSaveKey { &RegSaveKeyA; }
+sub RegSetValue { &RegSetValueA; }
+sub RegSetValueEx { &RegSetValueExA; }
+sub RegUnLoadKey { &RegUnLoadKeyA; }
+
+1;
+__END__
+
+=head1 NAME
+
+Win32API::Registry - Low-level access to Win32 system API calls from WINREG.H
+
+=head1 SYNOPSIS
+
+ use Win32API::Registry 0.21 qw( :ALL );
+
+ RegOpenKeyEx( HKEY_LOCAL_MACHINE, "SYSTEM\\Disk", 0, KEY_READ, $key )
+ or die "Can't open HKEY_LOCAL_MACHINE\\SYSTEM\\Disk: ",
+ regLastError(),"\n";
+ RegQueryValueEx( $key, "Information", [], $type, $data, [] )
+ or die "Can't read HKEY_L*MACHINE\\SYSTEM\\Disk\\Information: ",
+ regLastError(),"\n";
+ [...]
+ RegCloseKey( $key )
+ or die "Can't close HKEY_LOCAL_MACHINE\\SYSTEM\\Disk: ",
+ regLastError(),"\n";
+
+=head1 DESCRIPTION
+
+This provides fairly low-level access to the Win32 System API
+calls dealing with the Registry [mostly from WINREG.H]. This
+is mostly intended to be used by other modules such as
+C<Win32::TieRegistry> [which provides an extremely Perl-friendly
+method for using the Registry].
+
+For a description of the logical structure of the Registry, see
+the documentation for the C<Win32::TieRegistry> module.
+
+To pass in C<NULL> as the pointer to an optional buffer, pass in
+an empty list reference, C<[]>.
+
+Beyond raw access to the API calls and related constants, this module
+handles smart buffer allocation and translation of return codes.
+
+All calls return a true value for success and a false value for
+failure. After any failure, C<$^E> should automatically be set
+to indicate the reason. However, current versions of Perl often
+overwrite C<$^E> too quickly, so you can use C<regLastError()>
+instead, which is only set by Win32API::Registry routines.
+C<regLastError()> is also good if you have a really old version
+of Perl that does not connect C<$^E> to C<GetLastError()> on
+Win32.
+
+Note that C<$!> is not set by these routines except by
+C<Win32API::Registry::constant()> when a constant is not defined.
+
+=head2 Exports
+
+Nothing is exported by default. The following tags can be used to
+have sets of symbols exported.
+
+[Note that much of the following documentation refers to the
+behavior of the underlying API calls which may vary in current
+and future versions of the Win32 API without any changes to this
+module. Therefore you should check the Win32 API documentation
+directly when needed.]
+
+=over
+
+=item :Func
+
+The basic function names:
+
+=over
+
+=item AllowPriv
+
+=item C<AllowPriv( $sPrivName, $bEnable )>
+
+Not a Win32 API call. Enables or disables a specific privilege for
+the current process. Returns a true value if successful and a false
+value [and sets C<$^E>/C<regLastError()>] on failure. This routine
+does not provide a way to tell if a privilege is currently enabled.
+
+C<$sPrivname> is a Win32 privilege name [see L</:SE_>]. For example,
+C<"SeBackupPrivilege"> [a.k.a. C<SE_BACKUP_NAME>] controls whether
+you can use C<RegSaveKey()> and C<"SeRestorePrivilege"> [a.k.a.
+C<SE_RESTORE_NAME>] controls whether you can use C<RegLoadKey()>.
+
+If C<$bEnable> is true, then C<AllowPriv()> tries to enable the
+privilege. Otherwise it tries to disable the privilege.
+
+=item AbortSystemShutdown
+
+=item C<AbortSystemShutdown( $sComputerName )>
+
+Tries to abort a remote shutdown request previously made via
+C<InitiateSystemShutdown()>. Returns a true value if successful
+and a false value [and sets C<$^E>/C<regLastError()>] on failure.
+
+=item InitiateSystemShutdown
+
+=item C<InitiateSystemShutdown( $sComputer, $sMessage, $uTimeoutSecs, $bForce, $bReboot )>
+
+Requests that a [remote] computer be shutdown or rebooted.
+Returns a true value if successful and a false value [and
+sets C<$^E>/C<regLastError()>] on failure.
+
+C<$sComputer> is the name [or address] of the computer to be
+shutdown or rebooted. You can use C<[]> [for C<NULL>] or C<"">
+to indicate the local computer.
+
+C<$sMessage> is the message to be displayed in a pop-up window
+on the desktop of the computer to be shutdown or rebooted until
+the timeout expires or the shutdown is aborted via
+C<AbortSystemShutdown()>. With C<$iTimeoutSecs == 0>, the
+message will never be visible.
+
+C<$iTimeoutSecs> is the number of seconds to wait before starting
+the shutdown.
+
+If C<$bForce> is false, then any applications running on the remote
+computer get a chance to prompt the remote user whether they want
+to save changes. Also, for any applications that do not exit quickly
+enough, the operating system will prompt the user whether they wish
+to wait longer for the application to exit or force it to exit now.
+At any of these prompts the user can press B<CANCEL> to abort the
+shutdown but if no applications have unsaved data, they will likely
+all exit quickly and the shutdown will progress with the remote user
+having no option to cancel the shutdown.
+
+If C<$bForce> is true, all applications are told to exit immediately
+and so will not prompt the user even if there is unsaved data. Any
+applications that take too long to exit will be forcibly killed after
+a short time. The only way to abort the shutdown is to call
+C<AbortSystemShutdown()> before the timeout expires and there is no
+way to abort the shutdown once it has begun.
+
+If C<$bReboot> is true, the computer will automatically reboot once
+the shutdown is complete. If C<$bReboot> is false, then when the
+shutdown is complete the computer will halt at a screen indicating
+that the shutdown is complete and offering a way for the user to
+start to boot the computer.
+
+You must have the C<"SeRemoteShutdownPrivilege"> privilege
+on the remote computer for this call to succeed. If shutting
+down the local computer, then the calling process must have
+the C<"SeShutdownPrivilege"> privilege and have it enabled.
+
+=item RegCloseKey
+
+=item C<RegCloseKey( $hKey )>
+
+Closes the handle to a Registry key returned by C<RegOpenKeyEx()>,
+C<RegConnectRegistry()>, C<RegCreateKeyEx()>, or a few other
+routines. Returns a true value if successful and a false value
+[and sets C<$^E>/C<regLastError()>] on failure.
+
+=item RegConnectRegistry
+
+=item C<RegConnectRegistry( $sComputer, $hRootKey, $ohKey )>
+
+Connects to one of the root Registry keys of a remote computer.
+Returns a true value if successful and a false value [and
+sets C<$^E>/C<regLastError()>] on failure.
+
+C<$sComputer> is the name [or address] of a remote computer
+whose Registry you wish to access.
+
+C<$hKey> must be either C<HKEY_LOCAL_MACHINE> or C<HKEY_USERS>
+and specifies which root Registry key on the remote computer
+you wish to have access to.
+
+C<$phKey> will be set to the handle to be used to access the
+remote Registry key if the call succeeds.
+
+=item regConstant
+
+=item C<$value= regConstant( $sConstantName )>
+
+Fetch the value of a constant. Returns C<undef> if C<$sConstantName>
+is not the name of a constant supported by this module. Never sets
+C<$!> nor C<$^E>.
+
+This function is rarely used since you will usually get the value of a
+constant by having that constant imported into your package by listing
+the constant name in the C<use Win32API::Registry> statement and then
+simply using the constant name in your code [perhaps followed by
+C<()>]. This function is useful for verifying constant names not in
+Perl code, for example, after prompting a user to type in a constant
+name.
+
+=item RegCreateKey
+
+=item C<RegCreateKey( $hKey, $sSubKey, $ohSubKey )>
+
+This routine is meant only for compatibility with Windows version
+3.1. Use C<RegCreateKeyEx()> instead.
+
+=item RegCreateKeyEx
+
+=item C<RegCreateKeyEx( $hKey, $sSubKey, $uZero, $sClass, $uOpts, $uAccess, $pSecAttr, $ohNewKey, $ouDisp )>
+
+Creates a new Registry subkey. Returns a true value if successful and
+a false value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sSubKey> is the name of the new subkey to be created.
+
+C<$iZero> is reserved for future use and should always be specified
+as C<0>.
+
+C<$sClass> is a string to be used as the class for the new
+subkey. We are not aware of any current use for Registry key
+class information so the empty string, C<"">, should usually
+be used here.
+
+C<$iOpts> is a numeric value containing bits that control options
+used while creating the new subkey. C<REG_OPTION_NON_VOLATILE>
+is the default. C<REG_OPTION_VOLATILE> [which is ignored on
+Windows 95] means the data stored under this key is not kept
+in a file and will not be preserved when the system reboots.
+C<REG_OPTION_BACKUP_RESTORE> [also ignored on Windows 95] means
+ignore the C<$iAccess> parameter and try to open the new key with
+the access required to backup or restore the key.
+
+C<$iAccess> is a numeric mask of bits specifying what type of
+access is desired when opening the new subkey. See C<RegOpenKeyEx()>.
+
+C<$pSecAttr> is a C<SECURITY_ATTRIBUTES> structure packed into
+a Perl string which controls whether the returned handle can be
+inherited by child processes. Normally you would pass C<[]> for
+this parameter to have C<NULL> passed to the underlying API
+indicating that the handle cannot be inherited. If not under
+Windows95, then C<$pSecAttr> also allows you to specify
+C<SECURITY_DESCRIPTOR> that controls which users will have
+what type of access to the new key -- otherwise the new key
+inherits its security from its parent key.
+
+C<$phKey> will be set to the handle to be used to access the new
+subkey if the call succeeds.
+
+C<$piDisp> will be set to either C<REG_CREATED_NEW_KEY> or
+C<REG_OPENED_EXISTING_KEY> to indicate for which reason the
+call succeeded. Can be specified as C<[]> if you don't care.
+
+If C<$phKey> and C<$piDisp> start out as integers, then they will
+probably remain unchanged if the call fails.
+
+=item RegDeleteKey
+
+=item C<RegDeleteKey( $hKey, $sSubKey )>
+
+Deletes a subkey of an open Registry key provided that the subkey
+contains no subkeys of its own [but the subkey may contain values].
+Returns a true value if successful and a false value [and sets
+C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sSubKey> is the name of the subkey to be deleted.
+
+=item RegDeleteValue
+
+=item C<RegDeleteValue( $hKey, $sValueName )>
+
+Deletes a value from an open Registry key. Returns a true value if
+successful and a false value [and sets C<$^E>/C<regLastError()>] on
+failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sValueKey> is the name of the value to be deleted.
+
+=item RegEnumKey
+
+=item C<RegEnumKey( $hKey, $uIndex, $osName, $ilNameSize )>
+
+This routine is meant only for compatibility with Windows version
+3.1. Use C<RegEnumKeyEx()> instead.
+
+=item RegEnumKeyEx
+
+=item C<RegEnumKeyEx( $hKey, $uIndex, $osName, $iolName, $pNull, $osClass, $iolClass, $opftLastWrite )>
+
+Lets you enumerate the names of all of the subkeys directly under
+an open Registry key. Returns a true value if successful and a false
+value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$iIndex> is the sequence number of the immediate subkey that
+you want information on. Start with this value as C<0> then
+repeat the call incrementing this value each time until the
+call fails with C<$^E>/C<regLastError()> numerically equal to
+C<ERROR_NO_MORE_ITEMS>.
+
+C<$sName> will be set to the name of the subkey. Can be C<[]> if
+you don't care about the name.
+
+C<$plName> initially specifies the [minimum] buffer size to be
+allocated for C<$sName>. Will be set to the length of the subkey
+name if the requested subkey exists even if C<$sName> isn't
+successfully set to the subkey name. See L<Buffer sizes> for
+more information.
+
+C<$pNull> is reserved for future used and should be passed as C<[]>.
+
+C<$sClass> will be set to the class name for the subkey. Can be
+C<[]> if you don't care about the class.
+
+C<$plClass> initially specifies the [minimum] buffer size to be
+allocated for C<$sClass> and will be set to the length of the
+subkey class name if the requested subkey exists. See L<Buffer
+sizes> for more information.
+
+C<$pftLastWrite> will be set to a C<FILETIME> structure packed
+into a Perl string and indicating when the subkey was last changed.
+Can be C<[]>.
+
+You may omit both C<$plName> and C<$plClass> to get the same effect
+as passing in C<[]> for each of them.
+
+=item RegEnumValue
+
+=item C<RegEnumValue( $hKey, $uIndex, $osValName, $iolValName, $pNull, $ouType, $opValData, $iolValData )>
+
+Lets you enumerate the names of all of the values contained in an
+open Registry key. Returns a true value if successful and a false
+value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$iIndex> is the sequence number of the value that you want
+information on. Start with this value as C<0> then repeat the
+call incrementing this value each time until the call fails with
+C<ERROR_NO_MORE_ITEMS>.
+
+C<$sValName> will be set to the name of the value. Can be C<[]>
+if you don't care about the name.
+
+C<$plValName> initially specifies the [minimum] buffer size to be
+allocated for C<$sValName>. Will be set to the length of the value
+name if the requested value exists even if C<$sValName> isn't
+successfully set to the value name. See L<Buffer sizes> for
+more information.
+
+C<$pNull> is reserved for future used and should be passed as C<[]>.
+
+C<$piType> will be set to the type of data stored in the value data.
+If the call succeeds, it will be set to a C<REG_*> value unless
+passed in as C<[]>.
+
+C<$pValData> will be set to the data [packed into a Perl string]
+that is stored in the requested value. Can be C<[]> if you don't
+care about the value data.
+
+C<$plValData> initially specifies the [minimum] buffer size to be
+allocated for C<$sValData> and will be set to the length of the
+value data if the requested value exists. See L<Buffer sizes> for
+more information.
+
+You may omit both C<$plValName> and C<$plValData> to get the same
+effect as passing in C<[]> for each of them.
+
+=item RegFlushKey
+
+=item C<RegFlushKey( $hKey )>
+
+Forces the data stored under an open Registry key to be flushed
+to the disk file where the data is preserved between reboots.
+Forced flushing is not guaranteed to be efficient so this routine
+should almost never be called. Returns a true value if successful
+and a false value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+=item RegGetKeySecurity
+
+=item C<RegGetKeySecurity( $hKey, $uSecInfo, $opSecDesc, $iolSecDesc )>
+
+Retrieves one of the C<SECURITY_DESCRIPTOR> structures describing
+part of the security for an open Registry key. Returns a true value
+if successful and a false value [and sets C<$^E>/C<regLastError()>]
+on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$iSecInfo> is a numeric C<SECURITY_INFORMATION> value that
+specifies which parts of the C<SECURITY_DESCRIPTOR> structure
+to retrieve. Should be C<OWNER_SECURITY_INFORMATION>,
+C<GROUP_SECURITY_INFORMATION>, C<DACL_SECURITY_INFORMATION>, or
+or C<SACL_SECURITY_INFORMATION> or two or more of these bits
+combined using C<|>.
+
+C<$pSecDesc> will be set to the requested C<SECURITY_DESCRIPTOR>
+structure [packed into a Perl string].
+
+C<$plSecDesc> initially specifies the [minimum] buffer size to be
+allocated for C<$sSecDesc> and will be set to the length of the
+security descriptor. See L<Buffer sizes> for more information.
+You may omit this parameter to get the same effect as passing in
+C<[]> for it.
+
+=item regLastError
+
+=item C<$svError= regLastError();>
+
+=item C<regLastError( $uError );>
+
+Returns the last error encountered by a routine from this module.
+It is just like C<$^E> except it isn't changed by anything except
+routines from this module. Ideally you could just use C<$^E>, but
+current versions of Perl often overwrite C<$^E> before you get a
+chance to check it and really old versions of Perl don't really
+support C<$^E> under Win32.
+
+Just like C<$^E>, in a numeric context C<regLastError()> returns
+the numeric error value while in a string context it returns a
+text description of the error [actually it returns a Perl scalar
+that contains both values so C<$x= regLastError()> causes C<$x>
+to give different values in string vs. numeric contexts]. On old
+versions of Perl where C<$^E> isn't tied to C<GetLastError()>,
+C<regLastError> simply returns the number of the error and you'll
+need to use <Win32::FormatMessage> to get the error string.
+
+The last form sets the error returned by future calls to
+C<regLastError()> and should not be used often. C<$uError> must
+be a numeric error code. Also returns the dual-valued version
+of C<$uError>.
+
+=item RegLoadKey
+
+=item C<RegLoadKey( $hKey, $sSubKey, $sFileName )>
+
+Loads a hive file. That is, it creates a new subkey in the
+Registry and associates that subkey with a disk file that contains
+a Registry hive so that the new subkey can be used to access the
+keys and values stored in that hive. Hives are usually created
+via C<RegSaveKey()>. Returns a true value if successful and a
+false value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key that can have hives
+loaded to it. This must be C<HKEY_LOCAL_MACHINE>, C<HKEY_USERS>,
+or a remote version of one of these from a call to
+C<RegConnectRegistry()>.
+
+C<$sSubKey> is the name of the new subkey to created and associated
+with the hive file.
+
+C<$sFileName> is the name of the hive file to be loaded. This
+file name is interpreted relative to the
+C<%SystemRoot%/System32/config> directory on the computer where
+the C<$hKey> key resides. If C<$sFileName> is on a FAT file
+system, then its name must not have an extension.
+
+You must have the C<SE_RESTORE_NAME> privilege to use this routine.
+
+WARNING: Loading of hive files via a network share may silently
+corrupt the hive and so should not be attempted [this is a problem
+in at least some versions of the underlying API which this module
+does not try to fix or avoid]. To access a hive file located on a
+remote computer, connect to the remote computer's Registry and load
+the hive via that.
+
+=item RegNotifyChangeKeyValue
+
+=item C<RegNotifyChangeKeyValue( $hKey, $bWatchSubtree, $uNotifyFilter, $hEvent, $bAsync )>
+
+Arranges for your process to be notified when part of the Registry
+is changed. Returns a true value if successful and a false value
+[and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call] for which you wish to be notified when any changes
+are made to it.
+
+If C<$bWatchSubtree> is true, then changes to any subkey or
+descendant of C<$hKey> are also reported.
+
+C<$iNotifyFilter> controllers what types of changes are reported. It
+is a numeric value containing one or more of the following bit masks:
+
+=over
+
+=item C<REG_NOTIFY_CHANGE_NAME>
+
+Notify if a subkey is added or deleted to a monitored key.
+
+=item C<REG_NOTIFY_CHANGE_LAST_SET>
+
+Notify if a value in a monitored key is added, deleted, or modified.
+
+=item C<REG_NOTIFY_CHANGE_SECURITY>
+
+Notify if a security descriptor of a monitored key is changed.
+
+=item C<REG_NOTIFY_CHANGE_ATTRIBUTES>
+
+Notify if any attributes of a monitored key are changed [class
+name or security descriptors].
+
+=back
+
+C<$hEvent> is ignored unless C<$bAsync> is true. Otherwise, C<$hEvent>
+is a handle to a Win32 I<event> that will be signaled when changes are
+to be reported.
+
+If C<$bAsync> is true, then C<RegNotifyChangeKeyValue()> returns
+immediately and uses C<$hEvent> to notify your process of changes.
+If C<$bAsync> is false, then C<RegNotifyChangeKeyValue()> does
+not return until there is a change to be notified of.
+
+This routine does not work with Registry keys on remote computers.
+
+=item RegOpenKey
+
+=item C<RegOpenKey( $hKey, $sSubKey, $ohSubKey )>
+
+This routine is meant only for compatibility with Windows version
+3.1. Use C<RegOpenKeyEx()> instead.
+
+=item RegOpenKeyEx
+
+=item C<RegOpenKeyEx( $hKey, $sSubKey, $uOptions, $uAccess, $ohSubKey )>
+
+Opens an existing Registry key. Returns a true value if successful
+and a false value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sSubKey> is the name of an existing subkey to be opened.
+Can be C<""> or C<[]> to open an additional handle to the
+key specified by C<$hKey>.
+
+C<$iOptions> is a numeric value containing bits that control options
+used while opening the subkey. There are currently no supported
+options so this parameter should be specified as C<0>.
+
+C<$iAccess> is a numeric mask of bits specifying what type of
+access is desired when opening the new subkey. Should be a
+combination of one or more of the following bit masks:
+
+=over
+
+=item C<KEY_ALL_ACCESS>
+
+ KEY_READ | KEY_WRITE | KEY_CREATE_LINK
+
+=item C<KEY_READ>
+
+ KEY_QUERY_VALUE | KEY_ENUMERATE_SUBKEYS | KEY_NOTIFY | STANDARD_RIGHTS_READ
+
+=item C<KEY_WRITE>
+
+ KEY_SET_VALUE | KEY_CREATE_SUB_KEY | STANDARD_RIGHTS_WRITE
+
+=item C<KEY_QUERY_VALUE>
+
+=item C<KEY_SET_VALUE>
+
+=item C<KEY_ENUMERATE_SUB_KEYS>
+
+=item C<KEY_CREATE_SUB_KEY>
+
+=item C<KEY_NOTIFY>
+
+Allows you to use C<RegNotifyChangeKeyValue()> on the opened key.
+
+=item C<KEY_EXECUTE>
+
+Same as C<KEY_READ>.
+
+=item C<KEY_CREATE_LINK>
+
+Gives you permission to create a symbolic link like
+C<HKEY_CLASSES_ROOT> and C<HKEY_CURRENT_USER>, though the method for
+doing so is not documented [and probably requires use of the mostly
+undocumented "native" routines, C<Nt*()> a.k.a. C<Zw*()>].
+
+=back
+
+C<$phKey> will be set to the handle to be used to access the new subkey
+if the call succeeds.
+
+=item RegQueryInfoKey
+
+=item C<RegQueryInfoKey( $hKey, $osClass, $iolClass, $pNull, $ocSubKeys, $olSubKey, $olSubClass, $ocValues, $olValName, $olValData, $olSecDesc, $opftTime )>
+
+Gets miscellaneous information about an open Registry key.
+Returns a true value if successful and a false value [and
+sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sClass> will be set to the class name for the key. Can be
+C<[]> if you don't care about the class.
+
+C<$plClass> initially specifies the [minimum] buffer size to be
+allocated for C<$sClass> and will be set to the length of the
+key's class name. See L<Buffer sizes> for more information.
+You may omit this parameter to get the same effect as passing in
+C<[]> for it.
+
+C<$pNull> is reserved for future use and should be passed as C<[]>.
+
+C<$pcSubKeys> will be set to the count of the number of subkeys
+directly under this key. Can be C<[]>.
+
+C<$plSubKey> will be set to the length of the longest subkey name.
+Can be C<[]>.
+
+C<$plSubClass> will be set to the length of the longest class name
+used with an immediate subkey of this key. Can be C<[]>.
+
+C<$pcValues> will be set to the count of the number of values in
+this key. Can be C<[]>.
+
+C<$plValName> will be set to the length of the longest value name
+in this key. Can be C<[]>.
+
+C<$plValData> will be set to the length of the longest value data
+in this key. Can be C<[]>.
+
+C<$plSecDesc> will be set to the length of this key's full security
+descriptor.
+
+C<$pftTime> will be set to a C<FILETIME> structure packed
+into a Perl string and indicating when this key was last changed.
+Can be C<[]>.
+
+=item RegQueryMultipleValues
+
+=item C<RegQueryMultipleValues( $hKey, $ioarValueEnts, $icValueEnts, $opBuffer, $iolBuffer )>
+
+Allows you to use a single call to query several values from a single
+open Registry key to maximize efficiency. Returns a true value if
+successful and a false value [and sets C<$^E>/C<regLastError()>] on
+failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$pValueEnts> should contain a list of C<VALENT> structures packed
+into a single Perl string. Each C<VALENT> structure should have
+the C<ve_valuename> entry [the first 4 bytes] pointing to a string
+containing the name of a value stored in this key. The remaining
+fields are set if the function succeeds.
+
+C<$cValueEnts> should contain the count of the number of C<VALENT>
+structures contained in C<$pValueEnts>.
+
+C<$pBuffer> will be set to the data from all of the requested values
+concatenated into a single Perl string.
+
+C<$plBuffer> initially specifies the [minimum] buffer size to be
+allocated for C<$sBuffer> and will be set to the total length of
+the data to be written to C<$sBuffer>. See L<Buffer sizes> for
+more information. You may omit this parameter to get the same
+effect as passing in C<[]> for it.
+
+Here is sample code to populate C<$pValueEnts>:
+
+ # @ValueNames= ...list of value name strings...;
+ $cValueEnts= @ValueNames;
+ $pValueEnts= pack( " p x4 x4 x4 " x $cValueEnts, @ValueNames );
+
+Here is sample code to retrieve the data type and data length
+returned in C<$pValueEnts>:
+
+ @Lengths= unpack( " x4 L x4 x4 " x $cValueEnts, $pValueEnts );
+ @Types= unpack( " x4 x4 x4 L " x $cValueEnts, $pValueEnts );
+
+Given the above, and assuming you haven't modified C<$sBuffer> since
+the call, you can also extract the value data strings from C<$sBuffer>
+by using the pointers returned in C<$pValueEnts>:
+
+ @Data= unpack( join( "", map {" x4 x4 P$_ x4 "} @Lengths ),
+ $pValueEnts );
+
+Much better is to use the lengths and extract directly from
+C<$sBuffer> using C<unpack()> [or C<substr()>]:
+
+ @Data= unpack( join("",map("P$_",@Lengths)), $sBuffer );
+
+=item RegQueryValue
+
+=item C<RegQueryValue( $hKey, $sSubKey, $osValueData, $iolValueData )>
+
+This routine is meant only for compatibility with Windows version
+3.1. Use C<RegQueryValueEx()> instead. This routine can only
+query unnamed values [a.k.a. "default values"], that is, values with
+a name of C<"">.
+
+=item RegQueryValueEx
+
+=item C<RegQueryValueEx( $hKey, $sValueName, $pNull, $ouType, $opValueData, $iolValueData )>
+
+Lets you look up value data stored in an open Registry key by
+specifying the value name. Returns a true value if successful
+and a false value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sValueName> is the name of the value whose data you wish to
+retrieve.
+
+C<$pNull> this parameter is reserved for future use and should be
+specified as C<[]>.
+
+C<$piType> will be set to indicate what type of data is stored in
+the named value. Will be set to a C<REG_*> value if the function
+succeeds.
+
+C<$pValueData> will be set to the value data [packed into a Perl
+string] that is stored in the named value. Can be C<[]> if you
+don't care about the value data.
+
+C<$plValueData> initially specifies the [minimum] buffer size to be
+allocated for C<$sValueData> and will be set to the size [always
+in bytes] of the data to be written to C<$sValueData>, even if
+C<$sValueData> is not successfully written to. See L<Buffer sizes>
+for more information.
+
+=item RegReplaceKey
+
+=item C<RegReplaceKey( $hKey, $sSubKey, $sNewFile, $sOldFile )>
+
+Lets you replace an entire hive when the system is next booted.
+Returns a true value if successful and a false value [and sets
+C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key that has hive(s)
+loaded in it. This must be C<HKEY_LOCAL_MACHINE>,
+C<HKEY_USERS>, or a remote version of one of these from
+a call to C<RegConnectRegistry()>.
+
+C<$sSubKey> is the name of the subkey of C<$hKey> whose hive
+you wish to have replaced on the next reboot.
+
+C<$sNewFile> is the name of a file that will replace the existing
+hive file when the system reboots.
+
+C<$sOldFile> is the file name to save the current hive file to
+when the system reboots.
+
+C<$sNewFile> and C<$sOldFile> are interpreted relative to the
+C<%SystemRoot%/System32/config> directory on the computer where
+the C<$hKey> key resides [I think]. If either file is [would be]
+on a FAT file system, then its name must not have an extension.
+
+You must have the C<SE_RESTORE_NAME> privilege to use this routine.
+
+=item RegRestoreKey
+
+=item C<RegRestoreKey( $hKey, $sFileName, $uFlags )>
+
+Reads in a hive file and copies its contents over an existing
+Registry tree. Returns a true value if successful and a false
+value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sFileName> is the name of the hive file to be read. For each
+value and subkey in this file, a value or subkey will be added
+or replaced in C<$hKey>.
+
+C<$uFlags> is usually C<0>. It can also be C<REG_WHOLE_HIVE_VOLATILE>
+which, rather than copying the hive over the existing key,
+replaces the existing key with a temporary, memory-only Registry
+key and then copies the hive contents into it. This option only
+works if C<$hKey> is C<HKEY_LOCAL_MACHINE>, C<HKEY_USERS>, or a
+remote version of one of these from a call to C<RegConnectRegistry()>.
+
+C<RegRestoreKey> does I<not> delete values nor keys from the
+existing Registry tree when there is no corresponding value/key
+in the hive file.
+
+=item RegSaveKey
+
+=item C<RegSaveKey( $hKey, $sFileName, $pSecAttr )>
+
+Dumps any open Registry key and all of its subkeys and values into
+a new hive file. Returns a true value if successful and a false
+value [and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sFileName> is the name of the file that the Registry tree
+should be saved to. It is interpreted relative to the
+C<%SystemRoot%/System32/config> directory on the computer where
+the C<$hKey> key resides. If C<$sFileName> is on a FAT file system,
+then it must not have an extension.
+
+C<$pSecAttr> contains a C<SECURITY_ATTRIBUTES> structure that specifies
+the permissions to be set on the new file that is created. This can
+be C<[]>.
+
+You must have the C<SE_RESTORE_NAME> privilege to use this routine.
+
+=item RegSetKeySecurity
+
+=item C<RegSetKeySecurity( $hKey, $uSecInfo, $pSecDesc )>
+
+Sets [part of] the C<SECURITY_DESCRIPTOR> structure describing part
+of the security for an open Registry key. Returns a true value if
+successful and a false value [and sets C<$^E>/C<regLastError()>] on
+failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$uSecInfo> is a numeric C<SECURITY_INFORMATION> value that
+specifies which C<SECURITY_DESCRIPTOR> structure to set. Should
+be C<OWNER_SECURITY_INFORMATION>, C<GROUP_SECURITY_INFORMATION>,
+C<DACL_SECURITY_INFORMATION>, or C<SACL_SECURITY_INFORMATION>
+or two or more of these bits combined using C<|>.
+
+C<$pSecDesc> contains the new C<SECURITY_DESCRIPTOR> structure
+packed into a Perl string.
+
+=item RegSetValue
+
+=item C<RegSetValue( $hKey, $sSubKey, $uType, $sValueData, $lValueData )>
+
+This routine is meant only for compatibility with Windows version
+3.1. Use C<RegSetValueEx()> instead. This routine can only
+set unnamed values [a.k.a. "default values"].
+
+=item RegSetValueEx
+
+=item C<RegSetValueEx( $hKey, $sName, $uZero, $uType, $pData, $lData )>
+
+Adds or replaces a value in an open Registry key. Returns
+a true value if successful and a false value [and sets
+C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key [either C<HKEY_*> or from
+a previous call].
+
+C<$sName> is the name of the value to be set.
+
+C<$uZero> is reserved for future use and should be specified as C<0>.
+
+C<$uType> is the type of data stored in C<$pData>. It should
+be a C<REG_*> value.
+
+C<$pData> is the value data packed into a Perl string.
+
+C<$lData> is the length of the value data that is stored in C<$pData>.
+You will usually omit this parameter or pass in C<0> to have
+C<length($pData)> used. In both of these cases, if C<$iType> is
+C<REG_SZ> or C<REG_EXPAND_SZ>, C<RegSetValueEx()> will append a
+trailing C<'\0'> to the end of C<$pData> [unless there is already
+one].
+
+=item RegUnLoadKey
+
+=item C<RegUnLoadKey( $hKey, $sSubKey )>
+
+Unloads a previously loaded hive file. That is, closes the
+hive file then deletes the subkey that was providing access
+to it. Returns a true value if successful and a false value
+[and sets C<$^E>/C<regLastError()>] on failure.
+
+C<$hKey> is the handle to a Registry key that has hives
+loaded in it. This must be C<HKEY_LOCAL_MACHINE>, C<HKEY_USERS>,
+or a remote version of one of these from a call to
+C<RegConnectRegistry()>.
+
+C<$sSubKey> is the name of the subkey whose hive you wish to
+have unloaded.
+
+=item :FuncA
+
+The ASCII-specific function names.
+
+Each of these is identical to the version listed above without the
+trailing "A":
+
+ AbortSystemShutdownA InitiateSystemShutdownA
+ RegConnectRegistryA RegCreateKeyA RegCreateKeyExA
+ RegDeleteKeyA RegDeleteValueA RegEnumKeyA
+ RegEnumKeyExA RegEnumValueA RegLoadKeyA
+ RegOpenKeyA RegOpenKeyExA RegQueryInfoKeyA
+ RegQueryMultipleValuesA RegQueryValueA RegQueryValueExA
+ RegReplaceKeyA RegRestoreKeyA RegSaveKeyA
+ RegSetValueA RegSetValueExA RegUnLoadKeyA
+
+=item :FuncW
+
+The UNICODE-specific function names. These are the same as the
+versions listed above without the trailing "W" except that string
+parameters are UNICODE strings rather than ASCII strings, as
+indicated.
+
+=item AbortSystemShutdownW
+
+=item C<AbortSystemShutdownW( $swComputerName )>
+
+C<$swComputerName> is UNICODE.
+
+=item InitiateSystemShutdownW
+
+=item C<InitiateSystemShutdownW( $swComputer, $swMessage, $uTimeoutSecs, $bForce, $bReboot )>
+
+C<$swComputer> and C<$swMessage> are UNICODE.
+
+=item RegConnectRegistryW
+
+=item C<RegConnectRegistryW( $swComputer, $hRootKey, $ohKey )>
+
+C<$swComputer> is UNICODE.
+
+=item RegCreateKeyW
+
+=item C<RegCreateKeyW( $hKey, $swSubKey, $ohSubKey )>
+
+C<$swSubKey> is UNICODE.
+
+=item RegCreateKeyExW
+
+=item C<RegCreateKeyExW( $hKey, $swSubKey, $uZero, $swClass, $uOpts, $uAccess, $pSecAttr, $ohNewKey, $ouDisp )>
+
+C<$swSubKey> and C<$swClass> are UNICODE.
+
+=item RegDeleteKeyW
+
+=item C<RegDeleteKeyW( $hKey, $swSubKey )>
+
+C<$swSubKey> is UNICODE.
+
+=item RegDeleteValueW
+
+=item C<RegDeleteValueW( $hKey, $swValueName )>
+
+C<$swValueName> is UNICODE.
+
+=item RegEnumKeyW
+
+=item C<RegEnumKeyW( $hKey, $uIndex, $oswName, $ilwNameSize )>
+
+C<$oswName> is UNICODE and C<$ilwNameSize> is measured as number of
+C<WCHAR>s.
+
+=item RegEnumKeyExW
+
+=item C<RegEnumKeyExW( $hKey, $uIndex, $oswName, $iolwName, $pNull, $oswClass, $iolwClass, $opftLastWrite )>
+
+C<$swName> and C<$swClass> are UNICODE and C<$iolwName> and C<$iolwClass>
+are measured as number of C<WCHAR>s.
+
+=item RegEnumValueW
+
+=item C<RegEnumValueW( $hKey, $uIndex, $oswName, $iolwName, $pNull, $ouType, $opData, $iolData )>
+
+C<$oswName> is UNICODE and C<$iolwName> is measured as number
+of C<WCHAR>s.
+
+C<$opData> is UNICODE if C<$piType> is C<REG_SZ>, C<REG_EXPAND_SZ>,
+or C<REG_MULTI_SZ>. Note that C<$iolData> is measured as number
+of bytes even in these cases.
+
+=item RegLoadKeyW
+
+=item C<RegLoadKeyW( $hKey, $swSubKey, $swFileName )>
+
+C<$swSubKey> and C<$swFileName> are UNICODE.
+
+=item RegOpenKeyW
+
+=item C<RegOpenKeyW( $hKey, $swSubKey, $ohSubKey )>
+
+C<$swSubKey> is UNICODE.
+
+=item RegOpenKeyExW
+
+=item C<RegOpenKeyExW( $hKey, $swSubKey, $uOptions, $uAccess, $ohSubKey )>
+
+C<$swSubKey> is UNICODE.
+
+=item RegQueryInfoKeyW
+
+=item C<RegQueryInfoKeyW( $hKey, $oswClass, $iolwClass, $pNull, $ocSubKeys, $olwSubKey, $olwSubClass, $ocValues, $olwValName, $olValData, $olSecDesc, $opftTime )>
+
+C<$swClass> is UNICODE. C<$iolwClass>, C<$olwSubKey>, C<$olwSubClass>,
+and C<$olwValName> are measured as number of C<WCHAR>s. Note that
+C<$olValData> is measured as number of bytes.
+
+=item RegQueryMultipleValuesW
+
+=item C<RegQueryMultipleValuesW( $hKey, $ioarValueEnts, $icValueEnts, $opBuffer, $iolBuffer )>
+
+The C<ve_valuename> fields of the C<VALENT> [actually C<VALENTW>]
+structures in C<$ioarValueEnts> are UNICODE. Values of type C<REG_SZ>,
+C<REG_EXPAND_SZ>, and C<REG_MULTI_SZ> are written to C<$opBuffer>
+in UNICODE. Note that C<$iolBuffer> and the C<ve_valuelen> fields
+of the C<VALENT> [C<VALENTW>] structures are measured as number of
+bytes.
+
+=item RegQueryValueW
+
+=item C<RegQueryValueW( $hKey, $swSubKey, $oswValueData, $iolValueData )>
+
+C<$swSubKey> and C<$oswValueData> are UNICODE. Note that
+C<$iolValueData> is measured as number of bytes.
+
+=item RegQueryValueExW
+
+=item C<RegQueryValueExW( $hKey, $swName, $pNull, $ouType, $opData, $iolData )>
+
+C<$swName> is UNICODE.
+
+C<$opData> is UNICODE if C<$ouType> is C<REG_SZ>, C<REG_EXPAND_SZ>,
+or C<REG_MULTI_SZ>. Note that C<$iolData> is measured as number of
+bytes even in these cases.
+
+=item RegReplaceKeyW
+
+=item C<RegReplaceKeyW( $hKey, $swSubKey, $swNewFile, $swOldFile )>
+
+C<$swSubKey>, C<$swNewFile>, and C<$swOldFile> are UNICODE.
+
+=item RegRestoreKeyW
+
+=item C<RegRestoreKeyW( $hKey, $swFileName, $uFlags )>
+
+C<$swFileName> is UNICODE.
+
+=item RegSaveKeyW
+
+=item C<RegSaveKeyW( $hKey, $swFileName, $pSecAttr )>
+
+C<$swFileName> is UNICODE.
+
+=item RegSetValueW
+
+=item C<RegSetValueW( $hKey, $swSubKey, $uType, $swValueData, $lValueData )>
+
+C<$swSubKey> and C<$swValueData> are UNICODE. Note that
+C<$lValueData> is measured as number of bytes even though
+C<$swValueData> is always UNICODE.
+
+=item RegSetValueExW
+
+=item C<RegSetValueExW( $hKey, $swName, $uZero, $uType, $pData, $lData )>
+
+C<$swName> is UNICODE.
+
+C<$pData> is UNICODE if C<$uType> is C<REG_SZ>, C<REG_EXPAND_SZ>,
+or C<REG_MULTI_SZ>. Note that C<$lData> is measured as number of
+bytes even in these cases.
+
+=item RegUnLoadKeyW
+
+=item C<RegUnLoadKeyW( $hKey, $swSubKey )>
+
+C<$swSubKey> is UNICODE.
+
+=item :HKEY_
+
+All C<HKEY_*> constants:
+
+ HKEY_CLASSES_ROOT HKEY_CURRENT_CONFIG HKEY_CURRENT_USER
+ HKEY_DYN_DATA HKEY_LOCAL_MACHINE HKEY_PERFORMANCE_DATA
+ HKEY_USERS
+
+=item :KEY_
+
+All C<KEY_*> constants:
+
+ KEY_QUERY_VALUE KEY_SET_VALUE KEY_CREATE_SUB_KEY
+ KEY_ENUMERATE_SUB_KEYS KEY_NOTIFY KEY_CREATE_LINK
+ KEY_READ KEY_WRITE KEY_EXECUTE
+ KEY_ALL_ACCESS
+
+=item :REG_
+
+All C<REG_*> constants:
+
+ REG_CREATED_NEW_KEY REG_OPENED_EXISTING_KEY
+
+ REG_LEGAL_CHANGE_FILTER REG_NOTIFY_CHANGE_ATTRIBUTES
+ REG_NOTIFY_CHANGE_NAME REG_NOTIFY_CHANGE_LAST_SET
+ REG_NOTIFY_CHANGE_SECURITY REG_LEGAL_OPTION
+
+ REG_OPTION_BACKUP_RESTORE REG_OPTION_CREATE_LINK
+ REG_OPTION_NON_VOLATILE REG_OPTION_OPEN_LINK
+ REG_OPTION_RESERVED REG_OPTION_VOLATILE
+
+ REG_WHOLE_HIVE_VOLATILE REG_REFRESH_HIVE
+ REG_NO_LAZY_FLUSH
+
+ REG_NONE REG_SZ
+ REG_EXPAND_SZ REG_BINARY
+ REG_DWORD REG_DWORD_LITTLE_ENDIAN
+ REG_DWORD_BIG_ENDIAN REG_LINK
+ REG_MULTI_SZ REG_RESOURCE_LIST
+ REG_FULL_RESOURCE_DESCRIPTOR REG_RESOURCE_REQUIREMENTS_LIST
+
+=item :ALL
+
+All of the above.
+
+=item :SE_
+
+The strings for the following privilege names:
+
+ SE_ASSIGNPRIMARYTOKEN_NAME SE_AUDIT_NAME
+ SE_BACKUP_NAME SE_CHANGE_NOTIFY_NAME
+ SE_CREATE_PAGEFILE_NAME SE_CREATE_PERMANENT_NAME
+ SE_CREATE_TOKEN_NAME SE_DEBUG_NAME
+ SE_INCREASE_QUOTA_NAME SE_INC_BASE_PRIORITY_NAME
+ SE_LOAD_DRIVER_NAME SE_LOCK_MEMORY_NAME
+ SE_MACHINE_ACCOUNT_NAME SE_PROF_SINGLE_PROCESS_NAME
+ SE_REMOTE_SHUTDOWN_NAME SE_RESTORE_NAME
+ SE_SECURITY_NAME SE_SHUTDOWN_NAME
+ SE_SYSTEMTIME_NAME SE_SYSTEM_ENVIRONMENT_NAME
+ SE_SYSTEM_PROFILE_NAME SE_TAKE_OWNERSHIP_NAME
+ SE_TCB_NAME SE_UNSOLICITED_INPUT_NAME
+
+It can be difficult to successfully build this module in a way
+that makes these constants available. So some builds of this
+module may not make them available. For such builds, trying
+to export any of these constants will cause a fatal error.
+For this reason, none of these symbols are currently included
+in the C<":ALL"> grouping.
+
+=back
+
+=back
+
+=head2 The Win32API:: hierarchy
+
+This and the other Win32API:: modules are meant to expose the
+nearly raw API calls so they can be used from Perl code in any
+way they might be used from C code. This provides the following
+advantages:
+
+=over
+
+=item Many modules can be written by people that don't have a C compiler.
+
+=item Encourages more module code to be written in Perl [not C].
+
+Perl code is often much easier to inspect, debug, customize, and
+enhance than XS code.
+
+=item Allows those already familiar with the Win32 API to get
+off to a quick start.
+
+=item Provides an interactive tool for exploring even obscure
+details of the Win32 API.
+
+It can be very useful to interactively explore ad-hoc calls into
+parts of the Win32 API using:
+
+ perl -de 0
+
+=item Ensures that native Win32 data structures can be used.
+
+This allows maximum efficiency. It also allows data from one
+module [for example, time or security information from the
+C<Win32API::Registry> or C<Win32API::File> modules] to be used
+with other modules [for example, C<Win32API::Time> and
+C<Win32API::SecDesc>].
+
+=item Provides a single version of the XS interface to each API
+call where improvements can be collected.
+
+=back
+
+=head2 Buffer sizes
+
+For each parameter that specifies a buffer size, a value of C<0>
+can be passed. For parameter that are pointers to buffer sizes,
+you can also pass in C<NULL> by specifying an empty list reference,
+C<[]>. Both of these cases will ensure that the variable has
+I<some> buffer space allocated to it and pass in that buffer's
+allocated size. Many of the calls indicate, via C<ERROR_MORE_DATA>,
+that the buffer size was not sufficient and the F<Registry.xs>
+code will automatically enlarge the buffer to the required size
+and repeat the call.
+
+Numeric buffer sizes are used as minimum initial sizes for the
+buffers. The larger of this size and the size of space already
+allocated to the scalar will be passed to the underlying routine.
+If that size was insufficient, and the underlying call provides
+an easy method for determining the needed buffer size, then the
+buffer will be enlarged and the call repeated as above.
+
+The underlying calls define buffer size parameter as unsigned, so
+negative buffer sizes are treated as very large positive buffer
+sizes which usually cause C<malloc()> to fail.
+
+To force the F<Registry.xs> code to pass in a specific value for
+a buffer size, precede the size with an equals sign via C<"=".>.
+Buffer sizes that are passed in as strings starting with an equals
+sign will have the equal sign stripped and the remainder of the string
+interpreted as a number [via C's C<strtoul()> using only base 10]
+which will be passed to the underlying routine [even if the allocated
+buffer is actually larger]. The F<Registry.xs> code will enlarge the
+buffer to the specified size, if needed, but will not enlarge the
+buffer based on the underlying routine requesting more space.
+
+Some Reg*() calls may not currently set the buffer size when they
+return C<ERROR_MORE_DATA>. But some that are not documented as
+doing so, currently do so anyway. So the code assumes that any
+routine I<might> do this and resizes any buffers and repeats the
+call. We hope that eventually all routines will provide this
+feature.
+
+When you use C<[]> for a buffer size, you can still find the
+length of the data returned by using C<length($buffer)>. Note
+that this length will be in bytes while a few of the buffer
+sizes would have been in units of wide characters.
+
+Note that the RegQueryValueEx*() and RegEnumValue*() calls
+will trim the trailing C<'\0'> [if present] from the returned data
+values of type C<REG_SZ> or C<REG_EXPAND_SZ> but only if the
+value data length parameter is omitted [or specified as C<[]>].
+
+The RegSetValueEx*() calls will add a trailing C<'\0'> [if
+missing] to the supplied data values of type C<REG_SZ> and
+C<REG_EXPAND_SZ> but only if the value data length parameter
+is omitted [or specified as C<0>].
+
+=head2 Hungarian Notation
+
+The following abbreviations are used at the start of each parameter
+name to hint at aspects of how the parameter is used. The prefix
+is always in lower case and followed by a capital letter that starts
+the descriptive part of the parameter name. Several of the following
+abbreviations can be combined into a single prefix.
+
+Probably not all of these prefix notations are used by this module.
+This document section may be included in any C<Win32API> module and
+so covers some notations not used by this specific module.
+
+=over
+
+=item s
+
+A string. In C, a C<'\0'>-terminated C<char *>. In Perl, just a
+string except that it will be truncated at the first C<"\0">, if
+it contains one.
+
+=item sw
+
+A wide [UNICODE] string. In C, a C<L'\0'>-terminated C<WCHAR *>.
+In Perl, a string that contains UNICODE data. You can convert a
+string to UNICODE in Perl via:
+
+ $string= "This is an example string";
+ $unicode= pack( "S*", unpack("C*",$string), 0 );
+
+Note how C<, 0> above causes an explicit C<L'\0'> to be added since
+Perl's implicit C<'\0'> that it puts after each of its strings is not
+wide enough to terminate a UNICODE string. So UNICODE strings are
+different than regular strings in that the Perl version of a regular
+string will not include the trailing C<'\0'> while the Perl version
+of a UNICODE string must include the trailing C<L'\0'>.
+
+If a UNICODE string contains no non-ASCII characters, then you
+can convert it back into a normal string via:
+
+ $string= pack( "C*", unpack("S*",$unicode) );
+ $string =~ s/\0$//;
+
+=item p
+
+A pointer to some buffer [usually containing some C<struct>]. In C,
+a C<void *> or some other pointer type. In Perl, a string that is
+usually manipulated using C<pack> and C<unpack>. The "p" is usually
+followed by more prefix character(s) to indicate what type of data is
+stored in the buffer.
+
+=item a
+
+A packed array. In C, an array [usually of C<struct>s]. In Perl, a
+string containing the packed data. The "a" is usually followed by
+more prefix character(s) to indicate the data type of the elements.
+
+These packed arrays are also called "vectors" in places to avoid
+confusion with Perl arrays.
+
+=item n
+
+A generic number. In C, any of the integer or floating point data
+types. In Perl, a number; either an integer, unsigned, or double
+[IV, UV, or NV, respectively]. Usually an integer.
+
+=item iv
+
+A signed integral value. In C, any of the signed integer data types.
+In Perl, an integer [IV].
+
+=item u
+
+An unsigned integral value. In C, any of the unsigned integer data
+types. In Perl, an unsigned integer [UV].
+
+=item d
+
+A floating-point number. In C, a C<float> or C<double> or, perhaps,
+a C<long double>. In Perl, a double-precision floating-point number
+[NV].
+
+=item b
+
+A Boolean value. In C, any integer data type, though usually via
+a type alias of C<bool> or C<BOOL>, containing either a 0 [false] or
+non-zero [true] value. In Perl, a scalar containing a Boolean value
+[C<0>, C<"">, or C<undef> for "false" and anything else for "true"].
+
+=item c
+
+A count of items. In C, any integer data type. In Perl, an unsigned
+integer [UV]. Usually used in conjunction with a "vector" parameter
+[see L</a> above] to indicate the number of elements.
+
+=item l
+
+A length [in bytes]. In C, any integer data type. In Perl, an
+unsigned integer [UV]. Usually used in conjunction with a "string"
+or "pointer" parameter [see L</s> and L</p> above] to indicate the
+buffer size or the size of the value stored in the buffer.
+
+For strings, there is no general rule as to whether the trailing
+C<'\0'> is included in such sizes. For this reason, the C<Win32API>
+modules follow the Perl rule of always allocating one extra byte
+and reporting buffer sizes as being one smaller than allocated in
+case the C<'\0'> is not included in the size.
+
+=item lw
+
+A length measured as number of UNICODE characters. In C, a count
+of C<WCHAR>s. In Perl, an unsigned integer [UV] counting "shorts"
+[see "s" and "S" in C<pack> and C<unpack>].
+
+For UNICODE strings, the trailing C<L'\0'> may or may not be
+included in a length so, again, we always allocate extra room
+for one and don't report that extra space.
+
+=item h
+
+A handle. In C, a C<HANDLE> or more-specific handle data type.
+In Perl, an unsigned integer [UV]. In C, these handles are often
+actually some type of pointer, but Perl just treats them as opaque
+numbers, as it should. This prefix is also used for other pointers
+that are treated as integers in Perl code.
+
+=item r
+
+A record. In C, almost always a C<struct> or perhaps C<union>. Note
+that C C<struct>s are rarely passed by value so the "r" is almost
+always preceded by a "p" or "a" [see L</p> and L</a> above]. For
+the very rare unadorned "r", Perl stores the record in the same way
+as a "pr", that is, in a string. For the very rare case where Perl
+explicitly stores a pointer to the C<struct> rather than storing the
+C<struct> directly in a Perl string, the prefix "pp" or "ppr" or even
+"par" is used.
+
+=item sv
+
+=item rv
+
+=item hv
+
+=item av
+
+=item cv
+
+A Perl data type. Respectively, a scalar value [SV], a reference
+[RV] [usually to a scalar], a hash [HV], a Perl array [AV], or a Perl
+code reference [PVCV]. For the "hv", "av", and "cv" prefixes, a
+leading "rv" is usually assumed. For a parameter to an XS subroutine,
+a prefix of "sv" means the parameter is a scalar and so may be a string
+or a number [or C<undef>] or even both at the same time. So "sv"
+doesn't imply a leading "rv".
+
+=item Input or Output
+
+Whether a parameter is for input data, output data, or both is usually
+not reflected by the data type prefix. In cases where this is not
+obvious nor reflected in the parameter name proper, we may use the
+following in front of the data type prefix.
+
+=over
+
+=item i
+
+An input parameter given to the API [usually omitted].
+
+=item o
+
+An output-only parameter taken from the API. You should not get a
+warning if such a parameter is C<undef> when you pass it into the
+function. You should get an error if such a parameter is read-only.
+You can [usually] pass in C<[]> for such a parameter to have the
+parameter silently ignored.
+
+The output may be written directly into the Perl variable passed
+to the subroutine, the same way the buffer parameter to Perl's
+C<sysread()>. This method is often avoided in Perl because
+the call then lacks any visual cue that some parameters are being
+overwritten. But this method closely matches the C API which is
+what we are trying to do.
+
+=item io
+
+Input given to the API then overwritten with output taken from the
+API. You should get a warning [if B<-w> is in effect] if such a
+parameter is C<undef> when you pass it into the function [unless it
+is a buffer or buffer length parameter]. If the value is read-only,
+then [for most parameters] the output is silently not written. This
+is because it is often convenient to pass in read-only constants for
+many such parameters. You can also usually pass in C<[]> for such
+parameters.
+
+=back
+
+=item pp
+
+=item ppr
+
+=item par
+
+=item pap
+
+These are just unusual combinations of prefix characters described above.
+
+For each, a pointer is stored in a [4-byte] Perl string. You can
+usually use C<unpack "P"> to access the real data from Perl.
+
+For "ppr" [and often for "pp"], the pointer points directly at a
+C C<struct>. For "par", the pointer points to the first element
+of a C [packed] array of C<struct>s. For "pap", the pointer points
+to a C [packed] array of pointers to other things.
+
+=item ap
+
+Here we have a list of pointers packed into a single Perl string.
+
+=back
+
+
+=head1 BUGS
+
+The old ActiveState ports of Perl for Win32 [but not, ActivePerl, the
+ActiveState distributions of standard Perl 5.004 and beyond] do not support
+the tools for building extensions and so do not support this extension.
+
+No routines are provided for using the data returned in the C<FILETIME>
+buffers. Those are in the C<Win32API::Time> module.
+
+No routines are provided for dealing with UNICODE data effectively.
+See L</:FuncW> above for some simple-minded UNICODE methods.
+
+Parts of the module test will fail if used on a version of Perl
+that does not yet set C<$^E> based on C<GetLastError()>.
+
+On NT 4.0 [at least], the RegEnum*() calls do not set the required
+buffer sizes when returning C<ERROR_MORE_DATA> so this module will
+not grow the buffers in such cases. C<Win32::TieRegistry> overcomes
+this by using values from C<RegQueryInfoKey()> for buffer sizes in
+RegEnum* calls.
+
+On NT 4.0 [at least], C<RegQueryInfoKey()> on C<HKEY_PERFORMANCE_DATA>
+never succeeds. Also, C<RegQueryValueEx()> on C<HKEY_PERFORMANCE_DATA>
+never returns the required buffer size. To access C<HKEY_PERFORMANCE_DATA>
+you will need to keep growing the data buffer until the call succeeds.
+
+Because C<goto &subroutine> seems to be buggy under Win32 Perl,
+it is not used in the stubs in F<Registry.pm>.
+
+=head1 AUTHOR
+
+Tye McQueen, tye@metronet.com, http://www.metronet.com/~tye/.
+
+=head1 LICENSE
+
+perl
+
+=head1 SEE ALSO
+
+=over
+
+=item L<Win32::TieRegistry>
+
+=item L<Win32::Registry>
+
+=back
+
+=cut
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32API/Registry/cRegistry.pc b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32API/Registry/cRegistry.pc
new file mode 100644
index 0000000000..f984543fa8
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/Win32API/Registry/cRegistry.pc
@@ -0,0 +1,87 @@
+# Generated by cRegistry_pc.cxx.
+# Package Win32API::Registry with options:
+# CPLUSPLUS => q[1]
+# IFDEF => q[ /^SE_/ ? '__cplusplus' : /REG_/ ]
+# IMPORT_LIST => [q[/._/], q[!/[a-z]/]]
+# VALUES => { KEY_DELETE=>q[DELETE], KEY_READ_CONTROL=>q[READ_CONTROL], KEY_WRITE_OWNER=>q[WRITE_OWNER], KEY_SYNCHRONIZE=>q[SYNCHRONIZE], KEY_WRITE_DAC=>q[WRITE_DAC] }
+# WRITE_PERL => q[1]
+# Perl files eval'd:
+# Registry.pm => last if /^\s*(bootstrap|XSLoader::load)\b/
+# C files included:
+# Registry.xs => last if m#/[/*]\s*CONSTS_DEFINED\b|^\s*MODULE\b#
+sub HKEY_CLASSES_ROOT () { 0x80000000 }
+sub HKEY_CURRENT_CONFIG () { 0x80000005 }
+sub HKEY_CURRENT_USER () { 0x80000001 }
+sub HKEY_DYN_DATA () { 0x80000006 }
+sub HKEY_LOCAL_MACHINE () { 0x80000002 }
+sub HKEY_PERFORMANCE_DATA () { 0x80000004 }
+sub HKEY_USERS () { 0x80000003 }
+sub KEY_ALL_ACCESS () { 983103 }
+sub KEY_CREATE_LINK () { 32 }
+sub KEY_CREATE_SUB_KEY () { 4 }
+sub KEY_DELETE () { 65536 }
+sub KEY_ENUMERATE_SUB_KEYS () { 8 }
+sub KEY_EXECUTE () { 131097 }
+sub KEY_NOTIFY () { 16 }
+sub KEY_QUERY_VALUE () { 1 }
+sub KEY_READ () { 131097 }
+sub KEY_READ_CONTROL () { 131072 }
+sub KEY_SET_VALUE () { 2 }
+sub KEY_SYNCHRONIZE () { 1048576 }
+sub KEY_WRITE () { 131078 }
+sub KEY_WRITE_DAC () { 262144 }
+sub KEY_WRITE_OWNER () { 524288 }
+sub REG_BINARY () { 3 }
+sub REG_CREATED_NEW_KEY () { 1 }
+sub REG_DWORD () { 4 }
+sub REG_DWORD_BIG_ENDIAN () { 5 }
+sub REG_DWORD_LITTLE_ENDIAN () { 4 }
+sub REG_EXPAND_SZ () { 2 }
+sub REG_FULL_RESOURCE_DESCRIPTOR () { 9 }
+sub REG_LEGAL_CHANGE_FILTER () { 15 }
+sub REG_LEGAL_OPTION () { 15 }
+sub REG_LINK () { 6 }
+sub REG_MULTI_SZ () { 7 }
+sub REG_NONE () { 0 }
+sub REG_NOTIFY_CHANGE_ATTRIBUTES () { 2 }
+sub REG_NOTIFY_CHANGE_LAST_SET () { 4 }
+sub REG_NOTIFY_CHANGE_NAME () { 1 }
+sub REG_NOTIFY_CHANGE_SECURITY () { 8 }
+sub REG_NO_LAZY_FLUSH () { 4 }
+sub REG_OPENED_EXISTING_KEY () { 2 }
+sub REG_OPTION_BACKUP_RESTORE () { 4 }
+sub REG_OPTION_CREATE_LINK () { 2 }
+sub REG_OPTION_NON_VOLATILE () { 0 }
+sub REG_OPTION_OPEN_LINK () { 8 }
+sub REG_OPTION_RESERVED () { 0 }
+sub REG_OPTION_VOLATILE () { 1 }
+sub REG_REFRESH_HIVE () { 2 }
+sub REG_RESOURCE_LIST () { 8 }
+sub REG_RESOURCE_REQUIREMENTS_LIST () { 10 }
+sub REG_SZ () { 1 }
+sub REG_WHOLE_HIVE_VOLATILE () { 1 }
+sub SE_ASSIGNPRIMARYTOKEN_NAME () { 'SeAssignPrimaryTokenPrivilege' }
+sub SE_AUDIT_NAME () { 'SeAuditPrivilege' }
+sub SE_BACKUP_NAME () { 'SeBackupPrivilege' }
+sub SE_CHANGE_NOTIFY_NAME () { 'SeChangeNotifyPrivilege' }
+sub SE_CREATE_PAGEFILE_NAME () { 'SeCreatePagefilePrivilege' }
+sub SE_CREATE_PERMANENT_NAME () { 'SeCreatePermanentPrivilege' }
+sub SE_CREATE_TOKEN_NAME () { 'SeCreateTokenPrivilege' }
+sub SE_DEBUG_NAME () { 'SeDebugPrivilege' }
+sub SE_INCREASE_QUOTA_NAME () { 'SeIncreaseQuotaPrivilege' }
+sub SE_INC_BASE_PRIORITY_NAME () { 'SeIncreaseBasePriorityPrivilege' }
+sub SE_LOAD_DRIVER_NAME () { 'SeLoadDriverPrivilege' }
+sub SE_LOCK_MEMORY_NAME () { 'SeLockMemoryPrivilege' }
+sub SE_MACHINE_ACCOUNT_NAME () { 'SeMachineAccountPrivilege' }
+sub SE_PROF_SINGLE_PROCESS_NAME () { 'SeProfileSingleProcessPrivilege' }
+sub SE_REMOTE_SHUTDOWN_NAME () { 'SeRemoteShutdownPrivilege' }
+sub SE_RESTORE_NAME () { 'SeRestorePrivilege' }
+sub SE_SECURITY_NAME () { 'SeSecurityPrivilege' }
+sub SE_SHUTDOWN_NAME () { 'SeShutdownPrivilege' }
+sub SE_SYSTEMTIME_NAME () { 'SeSystemtimePrivilege' }
+sub SE_SYSTEM_ENVIRONMENT_NAME () { 'SeSystemEnvironmentPrivilege' }
+sub SE_SYSTEM_PROFILE_NAME () { 'SeSystemProfilePrivilege' }
+sub SE_TAKE_OWNERSHIP_NAME () { 'SeTakeOwnershipPrivilege' }
+sub SE_TCB_NAME () { 'SeTcbPrivilege' }
+sub SE_UNSOLICITED_INPUT_NAME () { 'SeUnsolicitedInputPrivilege' }
+1;
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
new file mode 100644
index 0000000000..9cb00193a5
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Cpanel/JSON/XS/.packlist
@@ -0,0 +1,6 @@
+C:\tlperl\bin\cpanel_json_xs
+C:\tlperl\bin\cpanel_json_xs.bat
+C:\tlperl\site\lib\Cpanel\JSON\XS.pm
+C:\tlperl\site\lib\Cpanel\JSON\XS\Boolean.pm
+C:\tlperl\site\lib\Cpanel\JSON\XS\Type.pm
+C:\tlperl\site\lib\auto\Cpanel\JSON\XS\XS.dll
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
new file mode 100644
index 0000000000..90c4962b77
--- /dev/null
+++ 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/Date/Parse/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Date/Parse/.packlist
new file mode 100644
index 0000000000..5e66e1a661
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Date/Parse/.packlist
@@ -0,0 +1,37 @@
+C:\tlperl\site\lib\Date\Format.pm
+C:\tlperl\site\lib\Date\Language.pm
+C:\tlperl\site\lib\Date\Language\Afar.pm
+C:\tlperl\site\lib\Date\Language\Amharic.pm
+C:\tlperl\site\lib\Date\Language\Austrian.pm
+C:\tlperl\site\lib\Date\Language\Brazilian.pm
+C:\tlperl\site\lib\Date\Language\Bulgarian.pm
+C:\tlperl\site\lib\Date\Language\Chinese.pm
+C:\tlperl\site\lib\Date\Language\Chinese_GB.pm
+C:\tlperl\site\lib\Date\Language\Czech.pm
+C:\tlperl\site\lib\Date\Language\Danish.pm
+C:\tlperl\site\lib\Date\Language\Dutch.pm
+C:\tlperl\site\lib\Date\Language\English.pm
+C:\tlperl\site\lib\Date\Language\Finnish.pm
+C:\tlperl\site\lib\Date\Language\French.pm
+C:\tlperl\site\lib\Date\Language\Gedeo.pm
+C:\tlperl\site\lib\Date\Language\German.pm
+C:\tlperl\site\lib\Date\Language\Greek.pm
+C:\tlperl\site\lib\Date\Language\Hungarian.pm
+C:\tlperl\site\lib\Date\Language\Icelandic.pm
+C:\tlperl\site\lib\Date\Language\Italian.pm
+C:\tlperl\site\lib\Date\Language\Norwegian.pm
+C:\tlperl\site\lib\Date\Language\Oromo.pm
+C:\tlperl\site\lib\Date\Language\Romanian.pm
+C:\tlperl\site\lib\Date\Language\Russian.pm
+C:\tlperl\site\lib\Date\Language\Russian_cp1251.pm
+C:\tlperl\site\lib\Date\Language\Russian_koi8r.pm
+C:\tlperl\site\lib\Date\Language\Sidama.pm
+C:\tlperl\site\lib\Date\Language\Somali.pm
+C:\tlperl\site\lib\Date\Language\Spanish.pm
+C:\tlperl\site\lib\Date\Language\Swedish.pm
+C:\tlperl\site\lib\Date\Language\Tigrinya.pm
+C:\tlperl\site\lib\Date\Language\TigrinyaEritrean.pm
+C:\tlperl\site\lib\Date\Language\TigrinyaEthiopian.pm
+C:\tlperl\site\lib\Date\Language\Turkish.pm
+C:\tlperl\site\lib\Date\Parse.pm
+C:\tlperl\site\lib\Time\Zone.pm
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA1/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA1/.packlist
new file mode 100644
index 0000000000..45cf93670f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA1/.packlist
@@ -0,0 +1,2 @@
+C:\tlperl\site\lib\Digest\SHA1.pm
+C:\tlperl\site\lib\auto\Digest\SHA1\SHA1.dll
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA1/SHA1.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA1/SHA1.dll
new file mode 100644
index 0000000000..6c5491ba86
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Digest/SHA1/SHA1.dll
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
new file mode 100644
index 0000000000..fca67c3c70
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/Locale/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..d4a2e08bb7
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Encode/compat/.packlist
@@ -0,0 +1,4 @@
+C:\tlperl\site\lib\Encode\compat.pm
+C:\tlperl\site\lib\Encode\compat\5006001.pm
+C:\tlperl\site\lib\Encode\compat\Alias.pm
+C:\tlperl\site\lib\Encode\compat\common.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
new file mode 100644
index 0000000000..0d31ba57a1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Listing/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..3ba10e7c5e
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/File/Which/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..6ce7b6a07a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Parser/.packlist
@@ -0,0 +1,8 @@
+C:\tlperl\site\lib\HTML\Entities.pm
+C:\tlperl\site\lib\HTML\Filter.pm
+C:\tlperl\site\lib\HTML\HeadParser.pm
+C:\tlperl\site\lib\HTML\LinkExtor.pm
+C:\tlperl\site\lib\HTML\Parser.pm
+C:\tlperl\site\lib\HTML\PullParser.pm
+C:\tlperl\site\lib\HTML\TokeParser.pm
+C:\tlperl\site\lib\auto\HTML\Parser\Parser.dll
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
new file mode 100644
index 0000000000..a2f658366c
--- /dev/null
+++ 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/Tagset/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Tagset/.packlist
new file mode 100644
index 0000000000..b0836c2d77
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTML/Tagset/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..c1f0a86213
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Cookies/.packlist
@@ -0,0 +1,3 @@
+C:\tlperl\site\lib\HTTP\Cookies.pm
+C:\tlperl\site\lib\HTTP\Cookies\Microsoft.pm
+C:\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
new file mode 100644
index 0000000000..20fe206daa
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Daemon/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..8a98075d65
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Date/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..80f40bf932
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Message/.packlist
@@ -0,0 +1,10 @@
+C:\tlperl\site\lib\HTTP\Config.pm
+C:\tlperl\site\lib\HTTP\Headers.pm
+C:\tlperl\site\lib\HTTP\Headers\Auth.pm
+C:\tlperl\site\lib\HTTP\Headers\ETag.pm
+C:\tlperl\site\lib\HTTP\Headers\Util.pm
+C:\tlperl\site\lib\HTTP\Message.pm
+C:\tlperl\site\lib\HTTP\Request.pm
+C:\tlperl\site\lib\HTTP\Request\Common.pm
+C:\tlperl\site\lib\HTTP\Response.pm
+C:\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
new file mode 100644
index 0000000000..9d7d8f27c9
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/HTTP/Negotiate/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..6cb34ec6af
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/HTML/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..301a4c1067
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/IO/String/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..255fd5c433
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/JSON/MaybeXS/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..ad241200dc
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/LWP/MediaTypes/.packlist
@@ -0,0 +1,2 @@
+C:\tlperl\site\lib\LWP\MediaTypes.pm
+C:\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
new file mode 100644
index 0000000000..5c97b8b327
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Math/Int64/.packlist
@@ -0,0 +1,5 @@
+C:\tlperl\site\lib\Math\Int64.pm
+C:\tlperl\site\lib\Math\Int64\die_on_overflow.pm
+C:\tlperl\site\lib\Math\Int64\native_if_available.pm
+C:\tlperl\site\lib\Math\UInt64.pm
+C:\tlperl\site\lib\auto\Math\Int64\Int64.dll
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
new file mode 100644
index 0000000000..8856f379aa
--- /dev/null
+++ 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/Mozilla/CA/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Mozilla/CA/.packlist
new file mode 100644
index 0000000000..a91ad79eae
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Mozilla/CA/.packlist
@@ -0,0 +1,3 @@
+C:\tlperl\site\lib\Mozilla\CA.pm
+C:\tlperl\site\lib\Mozilla\CA\cacert.pem
+C:\tlperl\site\lib\Mozilla\mk-ca-bundle.pl
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
new file mode 100644
index 0000000000..e71697e423
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Net/HTTP/.packlist
@@ -0,0 +1,4 @@
+C:\tlperl\site\lib\Net\HTTP.pm
+C:\tlperl\site\lib\Net\HTTPS.pm
+C:\tlperl\site\lib\Net\HTTP\Methods.pm
+C:\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 100644
index 0000000000..87d1fe32b2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Socket/.packlist
@@ -0,0 +1,2 @@
+C:\tlperl\site\lib\Socket.pm
+C:\tlperl\site\lib\auto\Socket\Socket.dll
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 100644
index 0000000000..2b8c6eb879
--- /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/Test/Fatal/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Fatal/.packlist
new file mode 100644
index 0000000000..f8b34dfe0f
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Fatal/.packlist
@@ -0,0 +1 @@
+C:\tlperl\site\lib\Test\Fatal.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
new file mode 100644
index 0000000000..740b7c46c2
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/Needs/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..2236c52f85
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Test/RequiresInternet/.packlist
@@ -0,0 +1 @@
+C:\tlperl\site\lib\Test\RequiresInternet.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
new file mode 100644
index 0000000000..44c33603fa
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Try/Tiny/.packlist
@@ -0,0 +1 @@
+C:\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
new file mode 100644
index 0000000000..9213ecb7b1
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/URI/.packlist
@@ -0,0 +1,53 @@
+C:\tlperl\site\lib\URI.pm
+C:\tlperl\site\lib\URI\Escape.pm
+C:\tlperl\site\lib\URI\Heuristic.pm
+C:\tlperl\site\lib\URI\IRI.pm
+C:\tlperl\site\lib\URI\QueryParam.pm
+C:\tlperl\site\lib\URI\Split.pm
+C:\tlperl\site\lib\URI\URL.pm
+C:\tlperl\site\lib\URI\WithBase.pm
+C:\tlperl\site\lib\URI\_foreign.pm
+C:\tlperl\site\lib\URI\_generic.pm
+C:\tlperl\site\lib\URI\_idna.pm
+C:\tlperl\site\lib\URI\_ldap.pm
+C:\tlperl\site\lib\URI\_login.pm
+C:\tlperl\site\lib\URI\_punycode.pm
+C:\tlperl\site\lib\URI\_query.pm
+C:\tlperl\site\lib\URI\_segment.pm
+C:\tlperl\site\lib\URI\_server.pm
+C:\tlperl\site\lib\URI\_userpass.pm
+C:\tlperl\site\lib\URI\data.pm
+C:\tlperl\site\lib\URI\file.pm
+C:\tlperl\site\lib\URI\file\Base.pm
+C:\tlperl\site\lib\URI\file\FAT.pm
+C:\tlperl\site\lib\URI\file\Mac.pm
+C:\tlperl\site\lib\URI\file\OS2.pm
+C:\tlperl\site\lib\URI\file\QNX.pm
+C:\tlperl\site\lib\URI\file\Unix.pm
+C:\tlperl\site\lib\URI\file\Win32.pm
+C:\tlperl\site\lib\URI\ftp.pm
+C:\tlperl\site\lib\URI\gopher.pm
+C:\tlperl\site\lib\URI\http.pm
+C:\tlperl\site\lib\URI\https.pm
+C:\tlperl\site\lib\URI\ldap.pm
+C:\tlperl\site\lib\URI\ldapi.pm
+C:\tlperl\site\lib\URI\ldaps.pm
+C:\tlperl\site\lib\URI\mailto.pm
+C:\tlperl\site\lib\URI\mms.pm
+C:\tlperl\site\lib\URI\news.pm
+C:\tlperl\site\lib\URI\nntp.pm
+C:\tlperl\site\lib\URI\pop.pm
+C:\tlperl\site\lib\URI\rlogin.pm
+C:\tlperl\site\lib\URI\rsync.pm
+C:\tlperl\site\lib\URI\rtsp.pm
+C:\tlperl\site\lib\URI\rtspu.pm
+C:\tlperl\site\lib\URI\sftp.pm
+C:\tlperl\site\lib\URI\sip.pm
+C:\tlperl\site\lib\URI\sips.pm
+C:\tlperl\site\lib\URI\snews.pm
+C:\tlperl\site\lib\URI\ssh.pm
+C:\tlperl\site\lib\URI\telnet.pm
+C:\tlperl\site\lib\URI\tn3270.pm
+C:\tlperl\site\lib\URI\urn.pm
+C:\tlperl\site\lib\URI\urn\isbn.pm
+C:\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
new file mode 100644
index 0000000000..854d05abe3
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/WWW/RobotRules/.packlist
@@ -0,0 +1,2 @@
+C:\tlperl\site\lib\WWW\RobotRules.pm
+C:\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
new file mode 100644
index 0000000000..1cba447ccf
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/.packlist
@@ -0,0 +1,7 @@
+C:\tlperl\site\lib\Win32\API.pm
+C:\tlperl\site\lib\Win32\API\Callback.pm
+C:\tlperl\site\lib\Win32\API\Callback\IATPatch.pod
+C:\tlperl\site\lib\Win32\API\Struct.pm
+C:\tlperl\site\lib\Win32\API\Type.pm
+C:\tlperl\site\lib\auto\Win32\API\API.dll
+C:\tlperl\site\lib\auto\Win32\API\Callback\Callback.dll
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
new file mode 100644
index 0000000000..787e19fed9
--- /dev/null
+++ 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/Callback/Callback.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/API/Callback/Callback.dll
new file mode 100644
index 0000000000..9877a24466
--- /dev/null
+++ 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/Console/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/.packlist
new file mode 100644
index 0000000000..1a443fac38
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Console/.packlist
@@ -0,0 +1,2 @@
+C:\tlperl\site\lib\Win32\Console.pm
+C:\tlperl\site\lib\auto\Win32\Console\Console.dll
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
new file mode 100644
index 0000000000..fe0cbf1d2e
--- /dev/null
+++ 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/OLE/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist
new file mode 100644
index 0000000000..eb21a2a013
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/OLE/.packlist
@@ -0,0 +1,11 @@
+C:\tlperl\site\lib\OLE.pm
+C:\tlperl\site\lib\Win32\OLE.pm
+C:\tlperl\site\lib\Win32\OLE\Const.pm
+C:\tlperl\site\lib\Win32\OLE\Enum.pm
+C:\tlperl\site\lib\Win32\OLE\Lite.pm
+C:\tlperl\site\lib\Win32\OLE\NEWS.pod
+C:\tlperl\site\lib\Win32\OLE\NLS.pm
+C:\tlperl\site\lib\Win32\OLE\TPJ.pod
+C:\tlperl\site\lib\Win32\OLE\TypeInfo.pm
+C:\tlperl\site\lib\Win32\OLE\Variant.pm
+C:\tlperl\site\lib\auto\Win32\OLE\OLE.dll
diff --git a/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll
new file mode 100644
index 0000000000..0b0103be05
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/OLE/OLE.dll
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
new file mode 100644
index 0000000000..2969a83465
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/Shortcut/.packlist
@@ -0,0 +1,2 @@
+C:\tlperl\site\lib\Win32\Shortcut.pm
+C:\tlperl\site\lib\auto\Win32\Shortcut\Shortcut.dll
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
new file mode 100644
index 0000000000..42eeda695d
--- /dev/null
+++ 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/TieRegistry/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/TieRegistry/.packlist
new file mode 100644
index 0000000000..090c67dccf
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32/TieRegistry/.packlist
@@ -0,0 +1,2 @@
+C:\tlperl\site\lib\Tie\Registry.pm
+C:\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
new file mode 100644
index 0000000000..f86d801641
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/Win32API/Registry/.packlist
@@ -0,0 +1,3 @@
+C:\tlperl\site\lib\Win32API\Registry.pm
+C:\tlperl\site\lib\Win32API\Registry\cRegistry.pc
+C:\tlperl\site\lib\auto\Win32API\Registry\Registry.dll
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
new file mode 100644
index 0000000000..f2dd358c53
--- /dev/null
+++ 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/libwww/perl/.packlist b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/libwww/perl/.packlist
new file mode 100644
index 0000000000..156f09f720
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/auto/libwww/perl/.packlist
@@ -0,0 +1,33 @@
+C:\tlperl\bin\lwp-download
+C:\tlperl\bin\lwp-download.bat
+C:\tlperl\bin\lwp-dump
+C:\tlperl\bin\lwp-dump.bat
+C:\tlperl\bin\lwp-mirror
+C:\tlperl\bin\lwp-mirror.bat
+C:\tlperl\bin\lwp-request
+C:\tlperl\bin\lwp-request.bat
+C:\tlperl\site\lib\LWP.pm
+C:\tlperl\site\lib\LWP\Authen\Basic.pm
+C:\tlperl\site\lib\LWP\Authen\Digest.pm
+C:\tlperl\site\lib\LWP\Authen\Ntlm.pm
+C:\tlperl\site\lib\LWP\ConnCache.pm
+C:\tlperl\site\lib\LWP\Debug.pm
+C:\tlperl\site\lib\LWP\DebugFile.pm
+C:\tlperl\site\lib\LWP\Debug\TraceHTTP.pm
+C:\tlperl\site\lib\LWP\MemberMixin.pm
+C:\tlperl\site\lib\LWP\Protocol.pm
+C:\tlperl\site\lib\LWP\Protocol\cpan.pm
+C:\tlperl\site\lib\LWP\Protocol\data.pm
+C:\tlperl\site\lib\LWP\Protocol\file.pm
+C:\tlperl\site\lib\LWP\Protocol\ftp.pm
+C:\tlperl\site\lib\LWP\Protocol\gopher.pm
+C:\tlperl\site\lib\LWP\Protocol\http.pm
+C:\tlperl\site\lib\LWP\Protocol\loopback.pm
+C:\tlperl\site\lib\LWP\Protocol\mailto.pm
+C:\tlperl\site\lib\LWP\Protocol\nntp.pm
+C:\tlperl\site\lib\LWP\Protocol\nogo.pm
+C:\tlperl\site\lib\LWP\RobotUA.pm
+C:\tlperl\site\lib\LWP\Simple.pm
+C:\tlperl\site\lib\LWP\UserAgent.pm
+C:\tlperl\site\lib\libwww\lwpcook.pod
+C:\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
new file mode 100644
index 0000000000..b4d4989a6a
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwpcook.pod
@@ -0,0 +1,310 @@
+=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
new file mode 100644
index 0000000000..f9f98a0f15
--- /dev/null
+++ b/systems/texlive/tlnet/tlpkg/tlperl/site/lib/libwww/lwptut.pod
@@ -0,0 +1,820 @@
+=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